working on preventing ratholes

working on preventing ratholes

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -1,5 +1,5 @@
 (ns babel.test.en
-  (:refer-clojure :exclude [get-in])
+  (:refer-clojure :exclude [assoc-in get-in])
   (:require [babel.directory :refer [models]]
             [babel.english :refer [analyze fo-ps generate medium morph parse sentences]]
             [babel.english.grammar :as grammar]
@@ -17,7 +17,7 @@
             #?(:cljs [cljs.test :refer-macros [deftest is]])
             #?(:clj [clojure.tools.logging :as log])
             #?(:cljs [babel.logjs :as log])
-            [dag_unify.core :refer [fail? fail-path-between get-in strip-refs unify]]))
+            [dag_unify.core :refer [assoc-in fail? fail-path-between get-in strip-refs unify]]))

 (defn display-expression [expr]
   {:en (morph expr)
@@ -352,9 +352,61 @@
             (= "she turns on the radio"
                generated)))))

-
-
-
-
-
-
+;; cats cannot read: generating with this spec
+;; should quickly return with nil (rather than
+;; running indefinitely trying to generate a matching
+;; expression).
+(def spec1 {:synsem {:cat :verb
+                     :sem {:pred :read
+                           :subj {:pred :woman}}
+                     :subcat '()}})
+
+(def spec2 {:synsem {:cat :verb
+                     :sem {:pred :read
+                           :subj {:pred :cat}}
+                     :subcat '()}})
+
+(deftest rathole-check-1
+  (let [med (medium)
+        spec {:synsem {:cat :verb
+                       :sem {:pred :read
+                             :subj {:pred :cat}}
+                       :subcat '()}}
+        lbs (babel.generate/lightning-bolts med spec 0 0)
+        good-lb (first (filter #(and (= (get-in % [:head :rule])
+                                        "transitive-vp-nonphrasal-head")
+                                     (= (get-in % [:head :head :english :english])
+                                        "read"))
+                               lbs))
+
+        comp-comp-spec (get-in good-lb [:comp :comp])
+        comp-spec (get-in good-lb [:comp])]
+
+    (is (not (empty? (babel.generate/lightning-bolts med (get-in good-lb [:head :comp]) 0 0))))
+    (is (empty? (babel.generate/lightning-bolts med (get-in good-lb [:comp]) 0 0)))))
+
+
+(deftest rathole-check-2
+  (let [med (medium)
+        spec {:synsem {:cat :verb
+                       :sem {:pred :read
+                             :subj {:pred :woman}}
+                       :subcat '()}}
+        lbs (babel.generate/lightning-bolts med spec 0 0)
+        good-lb (first (filter #(and (= (get-in % [:head :rule])
+                                        "transitive-vp-nonphrasal-head")
+                                     (= (get-in % [:head :head :english :english])
+                                        "read"))
+                               lbs))
+
+        comp-comp-spec (get-in good-lb [:comp :comp])
+        comp-spec (get-in good-lb [:comp])]
+
+    (is (not (empty? (babel.generate/lightning-bolts med (get-in good-lb [:head :comp]) 0 0))))
+    (is (not (empty? (babel.generate/lightning-bolts med (get-in good-lb [:comp]) 0 0))))))
+
+
+
+
+
+


~(defn tiny-model): more improvements

~(defn tiny-model): more improvements

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -898,7 +898,8 @@
                                     (= (get-in lexeme [:synsem :pronoun])
                                        true))))
                          lexemes)]
-             [k filtered-lexemes])))
+             (if (not (empty? filtered-lexemes))
+               [k filtered-lexemes]))))

    ;; filtered grammar:
    (fn [rule]


adding some more demand examples

adding some more demand examples

--- test/example/demand.clj
+++ test/example/demand.clj
@@ -1,9 +1,53 @@
 (ns example.demand
   (:use overtone.core))
-
+; Play a sequence of notes, where the demand ugen pulls them
+; each time it gets a trigger.
 (demo 2
       (let [trig (impulse:kr 8)
             freqs (dseq [440 880 220] Float/POSITIVE_INFINITY)
             note-gen (demand:kr trig 0 freqs)
             src (sin-osc note-gen)]
         (pan2 (* 0.1 src))))
+
+; Randomize the sequence of notes
+(demo 2
+      (let [trig (impulse:kr 8)
+            freqs (drand [440 880 220] Float/POSITIVE_INFINITY)
+            note-gen (demand:kr trig 0 freqs)
+            src (sin-osc note-gen)]
+        (pan2 (* 0.1 src))))
+
+; Randomize the sequence, but don't repeat already played notes
+(demo 2
+      (let [trig (impulse:kr 8)
+            freqs (dxrand [440 880 220] Float/POSITIVE_INFINITY)
+            note-gen (demand:kr trig 0 freqs)
+            src (sin-osc note-gen)]
+        (pan2 (* 0.1 src))))
+
+; TODO: Fixme
+; Generate a geometric sequence
+(demo 2
+      (let [trig (impulse:kr 8)
+            freqs (dgeom 1 1.2 10)
+            note-gen (+ 340 (* 30 (demand:kr trig 0 freqs)))
+            src (sin-osc note-gen)]
+        (pan2 (* 0.1 src))))
+
+; Another way to generate a sequence...?
+(demo 2
+      (let [trig (impulse:kr 8)
+            freqs (dser [440 880 220] Float/POSITIVE_INFINITY)
+            note-gen (demand:kr trig 0 freqs)
+            src (sin-osc note-gen)]
+        (pan2 (* 0.1 src))))
+
+; TODO: Fixme
+; Demanding noise...
+(demo 2
+      (let [trig (impulse:kr 8)
+            freqs (dwhite 0 20 Float/POSITIVE_INFINITY)
+            note-gen (+ 340 (* 30 (demand:kr trig 0 freqs)))
+            src (sin-osc note-gen)]
+        (pan2 (* 0.1 src))))
+


Fix for last commit

Fix for last commit

--- src/edu/berkeley/ai/util/hybrid.clj
+++ src/edu/berkeley/ai/util/hybrid.clj
@@ -1,6 +1,6 @@
 (ns edu.berkeley.ai.util.hybrid
-  (:use clojure.test  edu.berkeley.ai.util)
-  (:require [edu.berkeley.ai.util [propositions :as props]]))
+  (:use clojure.test  edu.berkeley.ai.util  )
+  (:require [edu.berkeley.ai.util [propositions :as props] [intervals :as iv]]))

 ;;; Helper types for expressions, assignments, and conditions
@@ -77,7 +77,7 @@
 (defmethod ground-and-simplify-numeric-expr   ::NumForm [expr var-map constant-numeric-fns numeric-vals]
   (let [form (props/simplify-atom var-map (:form expr))]
     (if (contains? constant-numeric-fns (first form))
-        (make-numeric-constant (interval-point (safe-get numeric-vals form)))
+        (make-numeric-constant (iv/interval-point (safe-get numeric-vals form)))
       (make-numeric-form form))))

 (defmethod extract-numeric-expr-form-and-diff ::NumForm [expr]


days of week

days of week

--- test/java_time_test.clj
+++ test/java_time_test.clj
@@ -509,8 +509,19 @@
       (is (not (j/not-before? fc fc+1000)))))

   (testing "fields"
-    (is (j/after? (j/day-of-week :saturday) :thursday))
-    (is (j/before? (j/day-of-week :saturday) :sunday))
+    (let [thursday (j/day-of-week :thursday)
+          saturday (j/day-of-week :saturday)
+          sunday (j/day-of-week :sunday)]
+      (is (j/after? saturday thursday))
+      (is (not (j/after? thursday saturday)))
+      (is (j/before? saturday sunday))
+      (is (not (j/before? sunday saturday)))
+      (is (j/not-after? saturday saturday))
+      (is (j/not-after? saturday sunday))
+      (is (not (j/not-after? sunday saturday)))
+      (is (j/not-before? saturday saturday))
+      (is (j/not-before? sunday saturday))
+      (is (not (j/not-before? saturday sunday))))

     (is (j/after? (j/month :february) :january))
     (is (j/before? (j/month :february) :march))


Drop the xml doctype for NLA records

Drop the xml doctype for NLA records

--- src/marcgrep/backends/nla.clj
+++ src/marcgrep/backends/nla.clj
@@ -37,7 +37,9 @@
                                  (apply str (keep (fn [id]
                                                     (when-not (.isDeleted ir id)
                                                       (let [doc (.document ir id)]
-                                                        (first (.getValues doc "fullrecord")))))
+                                                        (subs (first (.getValues doc "fullrecord"))
+                                                              ;; drops the leading: <?xml version="1.0" encoding="utf-8"?>
+                                                              38))))
                                                   batch))
                                  "</collection>")
                             "UTF-8")))]


Using when over if, fixed indentation

Using when over if, fixed indentation

--- src/metabase/pulse/render.clj
+++ src/metabase/pulse/render.clj
@@ -400,37 +400,38 @@
   "Render a single CARD for a `Pulse`. DATA is the `:data` from QP results (I think)."
   [card result]
   (try
-    (if (:error result) (throw (Exception. "Card has errors")))
+    (when (:error result)
+      (throw (Exception. "Card has errors")))
     (let [data (:data result)]
-    [:a {:href   (card-href card)
-         :target "_blank"
-         :style  (style section-style
-                        {:margin          :16px
-                         :margin-bottom   :16px
-                         :display         :block
-                         :text-decoration :none})}
-     (when *include-title*
-       [:table {:style (style {:margin-bottom :8px
-                               :width         :100%})}
-        [:tbody
-         [:tr
-          [:td [:span {:style header-style}
-                (-> card :name h)]]
-          [:td {:style (style {:text-align :right})}
-           (when *include-buttons*
-             [:img {:style (style {:width :16px})
-                    :width 16
-                    :src   (render-image-with-filename "frontend_client/app/img/external_link.png")}])]]]])
-     (case (detect-pulse-card-type card data)
-       :empty     (render:empty     card data)
-       :scalar    (render:scalar    card data)
-       :sparkline (render:sparkline card data)
-       :bar       (render:bar       card data)
-       :table     (render:table     card data)
-       [:div {:style (style font-style
-                            {:color       "#F9D45C"
-                             :font-weight 700})}
-        "We were unable to display this card." [:br] "Please view this card in Metabase."])])
+      [:a {:href   (card-href card)
+           :target "_blank"
+           :style  (style section-style
+                          {:margin          :16px
+                           :margin-bottom   :16px
+                           :display         :block
+                           :text-decoration :none})}
+       (when *include-title*
+         [:table {:style (style {:margin-bottom :8px
+                                 :width         :100%})}
+          [:tbody
+           [:tr
+            [:td [:span {:style header-style}
+                  (-> card :name h)]]
+            [:td {:style (style {:text-align :right})}
+             (when *include-buttons*
+               [:img {:style (style {:width :16px})
+                      :width 16
+                      :src   (render-image-with-filename "frontend_client/app/img/external_link.png")}])]]]])
+       (case (detect-pulse-card-type card data)
+         :empty     (render:empty     card data)
+         :scalar    (render:scalar    card data)
+         :sparkline (render:sparkline card data)
+         :bar       (render:bar       card data)
+         :table     (render:table     card data)
+         [:div {:style (style font-style
+                              {:color       "#F9D45C"
+                               :font-weight 700})}
+          "We were unable to display this card." [:br] "Please view this card in Metabase."])])
     (catch Throwable e
       (log/warn "Pulse card render error:" e)
       [:div {:style (style font-style


Tighten kv-seq implementation

Tighten kv-seq implementation

Some configs tested were tripping up on MapEntry's, which are not
collections in this system, but are in Clojure.  This is an attempt at
tightening that up.

--- src/aero/alpha/core.cljc
+++ src/aero/alpha/core.cljc
@@ -19,22 +19,25 @@
   "Implementation detail.  DO NOT USE.  Will be private once out of alpha."
   [x]
   (cond
-    (record? x)
-    x
-
-    (map? x)
+    (and (map? x) (not (record? x)))
     (with-meta
-      (or (seq x) [])
-      {`reassemble (fn [_ queue]
-                     (into (empty x) queue))})
-
-    (coll? x)
-    (with-meta (map-indexed (fn [idx v]
-                              [idx v])
-                            x)
+      (into [] x)
+      {`reassemble (fn [_ queue] (into {} queue))})
+
+    (set? x)
+    (with-meta (map-indexed (fn [idx v] [idx v]) x)
                {`reassemble (fn [_ queue]
-                              (into (empty x)
-                                    (map second (sort-by first queue))))})
+                              (set (map second queue)))})
+
+    (vector? x)
+    (with-meta (map-indexed (fn [idx v] [idx v]) x)
+               {`reassemble (fn [_ queue]
+                              (mapv second (sort-by first queue)))})
+
+    (list? x)
+    (with-meta (map-indexed (fn [idx v] [idx v]) x)
+               {`reassemble (fn [_ queue]
+                              (apply list (map second (sort-by first queue))))})
     ;; Scalar value
     :else
     nil))
@@ -125,7 +128,7 @@
   "Expand value x.  Dispatches on whether it's a scalar or collection.  If it's
   a collection it will expand the elements of the collection."
   [x opts env ks]
-  (if (and (not (record? x)) (coll? x))
+  (if (or (and (map? x) (not (record? x))) (set? x) (list? x) (vector? x))
     (expand-coll x opts env ks)
     (expand-scalar x opts env ks)))


that was supposed to be -1

that was supposed to be -1

--- test/runtime/q_test.clj
+++ test/runtime/q_test.clj
@@ -73,7 +73,7 @@
 ;(defn scInit [] (reset! oneAtom false))

 (def initialTimes 0)
-(def unInitializedTimes 0)
+(def unInitializedTimes -1)

 (def times (atom unInitializedTimes))


Remove unused key/value

Remove unused key/value

--- src/braid/client/ui/views/thread.cljs
+++ src/braid/client/ui/views/thread.cljs
@@ -283,7 +283,6 @@

           [new-message-view {:thread-id (thread :id)
                              :group-id (thread :group-id)
-                             :new-thread? new?
                              :placeholder (if new?
                                             "Start a conversation..."
                                             "Reply...")


Make sure the board data are read when patching a board.

--- src/oc/storage/api/boards.clj
+++ src/oc/storage/api/boards.clj
@@ -357,7 +357,7 @@
                          pairing-allowed? (or (and start direction)
                                               (and (not start) (not direction)))]
                      (not (and valid-start? valid-direction? pairing-allowed?))))
-    :patch false
+    :patch (fn [ctx] (api-common/malformed-json? ctx))
     :delete false})

   ;; Validations


Add test for non-vec vars

Add test for non-vec vars

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -674,4 +674,20 @@
         first
         (.-values))
   )
-  )
+
+  (let [rules [(Rule. [
+                       (aurora.language.Recall. :known&pretended, (js/aurora.language.fact :http/response #js ['content "google" 'tim]))
+                       (aurora.language.Output. :remembered (js/aurora.language.fact "1df7454c_069e_40ab_b117_b8d43212b473" #js ['value74]))
+                       (aurora.language.Output. :forgotten (js/aurora.language.fact "1df7454c_069e_40ab_b117_b8d43212b473" #js ['value]))
+                       (aurora.language.Recall. :known&pretended, (js/aurora.language.fact "1df7454c_069e_40ab_b117_b8d43212b473" #js ['value]))
+                       (aurora.language.Compute. (->Let 'value74  #{'value 'content} "value + \" hey \" + content"))])]
+        plan (add-rules empty-flow-plan rules)
+        state (flow-plan->flow-state plan)]
+    (add-facts state :known [(fact. "1df7454c_069e_40ab_b117_b8d43212b473" #js ["Click me"])])
+    (add-facts state :pretended [(fact. :http/response #js ["yo" "google" 1234])])
+    (fixpoint! state)
+    (map #(.-values %)
+         (-> state
+             (get-facts :remembered)))
+    )
+  )


Fix indention

Fix indention

--- src/clj/subman/sources/notabenoid.clj
+++ src/clj/subman/sources/notabenoid.clj
@@ -93,23 +93,23 @@
      :version ""
      :source const/type-notabenoid}))

-  (defn- episodes-from-book
-    "Get episodes from translation book"
-    [book]
-    (let [title (get-book-title book)]
-      (->> (html/select book [:table#Chapters :tbody :tr])
-           (filter (helpers/make-safe episode-ready? nil))
-           (map (helpers/make-safe episode-from-line nil))
-           (remove nil?)
-           (map #(assoc % :show title)))))
+(defn- episodes-from-book
+  "Get episodes from translation book"
+  [book]
+  (let [title (get-book-title book)]
+    (->> (html/select book [:table#Chapters :tbody :tr])
+         (filter (helpers/make-safe episode-ready? nil))
+         (map (helpers/make-safe episode-from-line nil))
+         (remove nil?)
+         (map #(assoc % :show title)))))

-  (defn get-release-page-result
-    "Get release page result"
-    [page]
-    (-<>> (get-release-page-url page)
-          helpers/fetch
-          (html/select <> [:ul.search-results :li :p :a])
-          (map (helpers/make-safe book-from-line nil))
-          (remove nil?)
-          (map episodes-from-book)
-          flatten))
+(defn get-release-page-result
+  "Get release page result"
+  [page]
+  (-<>> (get-release-page-url page)
+        helpers/fetch
+        (html/select <> [:ul.search-results :li :p :a])
+        (map (helpers/make-safe book-from-line nil))
+        (remove nil?)
+        (map episodes-from-book)
+        flatten))


Extract functions to add colors and set the current color

--- src/cljs/goya/components/palette.cljs
+++ src/cljs/goya/components/palette.cljs
@@ -47,6 +47,19 @@
         (om/build-all palette-entry-component palette {:init-state {:selectchan selectchan}})))))

+
+(defn set-paint-color [app color]
+  (om/update! app [:tools :paint-color] color))
+
+(defn add-color [app color]
+  (om/transact! app [:main-app :palette] #(conj % {:color color}))
+  (set-paint-color app color)
+  (om/transact! app
+                [:main-app :undo-history]
+                #(conj % {:action (str "Added Color: " color) :icon "droplet"})
+                :add-to-undo))
+
+
 (defn palette-component [app owner]
   (reify
     om/IInitState
@@ -59,19 +72,12 @@
       (let [addchan (om/get-state owner :addchan)
             selectchan (om/get-state owner :selectchan)]
         (go
-         (while true
-          (let [[v ch] (alts! [addchan selectchan])]
-            (when (= ch addchan)
-              (om/transact! app
-                            [:main-app :palette] #(conj % {:color v}))
-              (om/update! app
-                          [:tools :paint-color] v)
-              (om/transact! app
-                            [:main-app :undo-history]
-                            #(conj % {:action (str "Added Color: " v) :icon "droplet"})
-                            :add-to-undo))
-            (when (= ch selectchan)
-              (om/update! app [:tools :paint-color] v)))))))
+          (while true
+            (let [[v ch] (alts! [addchan selectchan])]
+              (when (= ch addchan)
+                (add-color app v))
+              (when (= ch selectchan)
+                (set-paint-color app v)))))))

     om/IRenderState
     (render-state [this {:keys [addchan selectchan]}]


swap TCP interface for HTTP

swap TCP interface for HTTP

--- src/block_chain/core.clj
+++ src/block_chain/core.clj
@@ -2,7 +2,7 @@
   (:require [block-chain.miner :as miner]
             [block-chain.db :as db]
             [clojure.tools.nrepl.server :as repl]
-            [block-chain.net :as net]))
+            [block-chain.http :as http]))

 (defonce repl-server (atom nil))

@@ -14,13 +14,13 @@
 (defn start! []
   (println "****** Starting Clarke Coin *******")
   (miner/run-miner!)
-  (net/start!)
+  (http/start! 3000)
   (start-repl!))

 (defn stop! []
   (println "****** Stopping Clarke Coin *******")
   (miner/stop-miner!)
-  (net/shutdown!)
+  (http/stop!)
   (repl/stop-server @repl-server))

 (defn -main [& args]


Fixed bug where exception was being thrown when large results were returned by redis.

--- src/main/clojure/redis/internal.clj
+++ src/main/clojure/redis/internal.clj
@@ -120,6 +120,11 @@
 (defmethod parse-reply \+
   [#^BufferedReader reader]
   (read-line-crlf reader))
+
+(defn- do-read [#^Reader reader #^chars cbuf offset length]
+  (let [nread (.read reader cbuf offset length)]
+    (if (not= nread length)
+      (recur reader cbuf (+ offset nread) (- length nread)))))

 (defmethod parse-reply \$
   [#^BufferedReader reader]
@@ -127,14 +132,12 @@
         length (parse-int line)]
     (if (< length 0)
       nil
-      (let [#^chars cbuf (char-array length)
-            nread (.read reader cbuf 0 length)]
-        (if (not= nread length)
-          (throw (Exception. "Could not read correct number of bytes"))
-          (do
-            (read-crlf reader) ;; CRLF
-            (String. cbuf)))))))
-
+      (let [#^chars cbuf (char-array length)]
+        (do
+          (do-read reader cbuf 0 length)
+          (read-crlf reader) ;; CRLF
+          (String. cbuf))))))
+
 (defmethod parse-reply \*
   [#^BufferedReader reader]
   (let [line (read-line-crlf reader)


Revert "Changes workflow from interactive-form to http-basic."

This reverts commit ae8020769e889e5774f8e3cdf1532d65ce272b7b.

--- src/cadence/security.clj
+++ src/cadence/security.clj
@@ -8,7 +8,7 @@

 (def friend-settings
       {:credential-fn (partial creds/bcrypt-credential-fn model/get-user)
-       :workflows [(workflows/http-basic)]
+       :workflows [(workflows/interactive-form)]
        :login-uri "/login"
        :unauthorized-redirect-uri "/login"
        :default-landing-uri "/"})


formatting

formatting

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -172,7 +172,7 @@
         (do
           (timbre/warnf "Malformed new message: %s" (pr-str new-message))
           (when-let [cb ?reply-fn]
-          (cb :braid/error)))))))
+            (cb :braid/error)))))))

 (defmethod event-msg-handler :user/subscribe-to-tag
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]


add private debug-prn to closure.clj as well

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -52,6 +52,10 @@
            com.google.javascript.jscomp.Result
            com.google.javascript.jscomp.JSError
            com.google.javascript.jscomp.CommandLineRunner))
+
+(defmacro ^:private debug-prn
+  [& args]
+  `(.println System/err (str ~@args)))

 (def name-chars (map char (concat (range 48 57) (range 65 90) (range 97 122))))


refactor Java imports / usage

refactor Java imports / usage

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -43,33 +43,24 @@
             [clojure.java.io :as io]
             [clojure.string :as string]
             [clojure.data.json :as json])
-  (:import java.io.File
-           java.io.BufferedInputStream
-           java.net.URL
-           java.util.logging.Level
-           java.util.List
-           com.google.javascript.jscomp.CompilerOptions
-           com.google.javascript.jscomp.CompilerOptions$LanguageMode
-           com.google.javascript.jscomp.CompilationLevel
-           com.google.javascript.jscomp.SourceMap$Format
-           com.google.javascript.jscomp.SourceMap$DetailLevel
-           com.google.javascript.jscomp.ClosureCodingConvention
-           com.google.javascript.jscomp.SourceFile
-           com.google.javascript.jscomp.Result
-           com.google.javascript.jscomp.JSError
-           com.google.javascript.jscomp.CheckLevel
-           com.google.javascript.jscomp.DiagnosticGroups
-           com.google.javascript.jscomp.CommandLineRunner
-           com.google.javascript.jscomp.AnonymousFunctionNamingPolicy
-           java.security.MessageDigest
-           javax.xml.bind.DatatypeConverter
+  (:import [java.io File BufferedInputStream]
+           [java.net URL]
+           [java.util.logging Level]
+           [java.util List Random]
+           [com.google.javascript.jscomp CompilerOptions CompilationLevel
+              CompilerOptions$LanguageMode SourceMap$Format
+              SourceMap$DetailLevel ClosureCodingConvention SourceFile
+              Result JSError CheckLevel DiagnosticGroups
+              CommandLineRunner AnonymousFunctionNamingPolicy]
+           [java.security MessageDigest]
+           [javax.xml.bind DatatypeConverter]
            [java.nio.file Paths StandardWatchEventKinds WatchKey]
            [com.sun.nio.file SensitivityWatchEventModifier]))

 (def name-chars (map char (concat (range 48 57) (range 65 90) (range 97 122))))

 (defn random-char []
-  (nth name-chars (.nextInt (java.util.Random.) (count name-chars))))
+  (nth name-chars (.nextInt (Random.) (count name-chars))))

 (defn random-string [length]
   (apply str (take length (repeatedly random-char))))
@@ -345,7 +336,7 @@
     (if output-file
       (let [out-file (io/file (util/output-directory opts) output-file)]
         (compiled-file (comp/compile-file file out-file opts)))
-      (binding [ana/*cljs-file* (.getPath ^java.io.File file)]
+      (binding [ana/*cljs-file* (.getPath ^File file)]
         (compile-form-seq (ana/forms-seq file)))))

 (defn compile-dir


CLJ-2032 Add check that :args spec exists before conforming fspec

Signed-off-by: Stuart Halloway <4dc50fc3bc007be011b5445f3f79298b9eeb51b7@cognitect.com>

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -1682,9 +1682,11 @@
      (specize* [s _] s)

      Spec
-     (conform* [_ f] (if (ifn? f)
-                       (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid)
-                       ::invalid))
+     (conform* [this f] (if argspec
+                          (if (ifn? f)
+                            (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid)
+                            ::invalid)
+                          (throw (Exception. (str "Can't conform fspec without args spec: " (pr-str (describe this)))))))
      (unform* [_ f] f)
      (explain* [_ path via in f]
                (if (ifn? f)


configs fallback - they we're breaking stacks in earlier docker versions

--- src/clj/swarmpit/api.clj
+++ src/clj/swarmpit/api.clj
@@ -121,8 +121,9 @@
   ([]
    (configs nil))
   ([label]
-   (-> (dc/configs label)
-       (dmi/->configs))))
+   (try (-> (dc/configs label)
+            (dmi/->configs))
+        (catch Exception _ {}))))

 (defn config
   [config-id]


quote-string is a helper fn to pr-writer we'll deal with later.

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -193,6 +193,7 @@
                     cljs.core/is_proto_
                     cljs.core/type
                     cljs.core/type->str
+                    cljs.core/quote-string
                     cljs.core/pr-writer
                     cljs.core/js-obj
                     cljs.core/js-keys


Experiment more with meta-errors

Experiment more with meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -685,7 +685,7 @@
                          (< e (max p1e p2e)) 1
                          :else 2)))
                 (vec (repeat (count (:errors ind)) 2)))
-              (if (and (:parent1-errors ind)
+              #_(if (and (:parent1-errors ind)
                        (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
                                              (:errors ind)
@@ -713,7 +713,7 @@
                          (= e (max p1e p2e)) 4
                          :else 5)))
                 (vec (repeat (count (:errors ind)) 5)))
-              #_(if (and (:parent1-errors ind)
+              (if (and (:parent1-errors ind)
                        (:parent2-errors ind))
                 (vec (for [[e p1e p2e] (mapv #(vector %1 %2 %3)
                                              (:errors ind)


Do not fail when jira is empty

Do not fail when jira is empty

--- src/github_changelog/conventional.clj
+++ src/github_changelog/conventional.clj
@@ -23,8 +23,9 @@
 (def jira-pattern (fixes-pattern "\\[?([A-Z]+-\\d+)\\]?"))

 (defn jira-issues [{:keys [jira]} pull]
-  (let [base (str (strip-trailing jira) "/browse/")]
-    (collect-issues pull jira-pattern (partial str base))))
+  (when (seq jira)
+    (let [base (str (strip-trailing jira) "/browse/")]
+      (collect-issues pull jira-pattern (partial str base)))))

 (def github-pattern (fixes-pattern "(#\\d+)"))


Add possibility to change row directly from cell views and editors

--- src/reabledit/components.cljs
+++ src/reabledit/components.cljs
@@ -9,7 +9,7 @@
 ;;

 (defn default-view
-  [row-data k enable-edit! _]
+  [row-data k _ enable-edit! _]
   [:div.reabledit-cell-view
    [:span.reabledit-cell__content
     (get row-data k)]
@@ -21,7 +21,7 @@
      :on-cut util/default-cut}]])

 (defn dropdown-view
-  [row-data k enable-edit! {:keys [options]}]
+  [row-data k _ enable-edit! {:keys [options]}]
   [:div.reabledit-cell-view
    [:span.reabledit-cell__content
     (-> (filter #(= (:key %) (get row-data k)) options)
@@ -46,7 +46,7 @@
 ;;

 (defn default-editor
-  [_ edited-row-data k change-edited! _]
+  [_ edited-row-data k change-edited! _ _]
   [:input.reabledit-cell-editor-input
    {:type "text"
     :auto-focus true
@@ -57,7 +57,7 @@
                                   (-> % .-target .-value)))}])

 (defn int-editor
-  [initial-row-data edited-row-data k change-edited! _]
+  [initial-row-data edited-row-data k change-edited! _ _]
   (let [initial-value (get initial-row-data k)
         input-candidate (str (get edited-row-data k))
         parsed (util/parse-int input-candidate initial-value)
@@ -65,7 +65,7 @@
     (change-edited! (assoc edited-row-data
                            k
                            parsed))
-    (fn [initial-row-data edited-row-data k change-edited! _]
+    (fn [initial-row-data edited-row-data k change-edited! _ _]
       [:input.reabledit-cell-editor-input
        {:type "text"
         :class (if-not (util/int-coercable? @input)
@@ -100,11 +100,11 @@
       nil)))

 (defn dropdown-editor
-  [_ edited-row-data k change-edited! disable-edit! {:keys [options]}]
+  [_ edited-row-data k change-edited! _ disable-edit! {:keys [options]}]
   (reagent/create-class
    {:component-did-mount #(.focus (reagent/dom-node %))
     :reagent-render
-    (fn [_ edited-row-data k change-edited! disable-edit! {:keys [options]}]
+    (fn [_ edited-row-data k change-edited! _ disable-edit! {:keys [options]}]
       (let [v (get edited-row-data k)
             change-edited! #(change-edited! (assoc edited-row-data k %))]
         [:div.reabledit-cell-editor-dropdown
@@ -138,6 +138,9 @@
                                                           state
                                                           column-key
                                                           row-id)
+        change-this-row! (partial row-change-fn
+                                  (util/find-index row-ids row-id)
+                                  row-data)
         enable-edit-in-this-cell! (partial util/enable-edit!
                                            state
                                            row-data
@@ -169,11 +172,13 @@
         (get-in @state [:edit :updated])
         column-key
         #(swap! state assoc-in [:edit :updated] %)
+        change-this-row!
         disable-edit-and-select-this-cell!
         (:opts column)]
        [(or (:view column) default-view)
         row-data
         column-key
+        change-this-row!
         enable-edit-in-this-cell!
         (:opts column)])]))


Added a container, cleaned up some forms

--- src-cljs/tea_time/core.cljs
+++ src-cljs/tea_time/core.cljs
@@ -89,7 +89,7 @@
                            :handler (fn [] (println "New Tea Posted") (get-teas) (reset! new-tea nil))
                            :error-handler (fn [err] (println "New Tea Failed To Post" err))}))

-(defn show-edit-form
+(defn show-edit-form
   "show/hide the show-edit-form"
   [id name]
   (println "show-edit-form" id "||" name "||" show-edit "||" @show-edit)
@@ -133,12 +133,12 @@
 (defn tea-edit
   "The component of the form"
   []
-  [:div.form-group
+  [:div.form-group
    [:div.row
     [:div.col-md-12
      [:div.p (str "Preview: " (or @edit-tea-snap "*no tea selected*") " -> " (or @edit-tea "*no tea selected*"))]
      [:div.p]
-     [:form
+     [:form
       [:input.form-control {:field :text :id :change-tea :value @edit-tea :on-change #(reset! edit-tea (-> % .-target .-value))}]
       [:input.btn.btn-info {:type "submit" :value "Update Tea Name" :on-click #((update-tea @edit-tea-id @edit-tea)
                                                                                (reset! edit-tea nil)
@@ -148,7 +148,7 @@
 ;; this passes the value of the new tea atom into the post-to-teas-db function

 (defn list-page []
-    [:div.container
+    [:div.container
      [:div.row
       [:div.col-md-12
        "Here is a list of teas"]]
@@ -180,7 +180,7 @@

 (secretary/defroute "/list-page" []
   (session/put! :page :list-page))
-
+

 ;; -------------------------
 ;; History


HTTP client: new Clojure API

HTTP client: new Clojure API

--- src/me/shenfeng/http/client.clj
+++ src/me/shenfeng/http/client.clj
@@ -1,46 +1,105 @@
 (ns me.shenfeng.http.client
-  (:refer-clojure :exclude [get])
   (:require [clojure.string :as str])
   (:import [me.shenfeng.http.client HttpClientConfig HttpClient
             IResponseHandler RespListener RespListener$IFilter]
            (java.net URI URLEncoder)
            me.shenfeng.http.HttpMethod))

-(defn- url-encode
-  "Returns an UTF-8 URL encoded version of the given string."
-  [unencoded]
-  (URLEncoder/encode unencoded "UTF-8"))
-
-(defn- transform-header [headers keyify?]
+(defn- normalize-headers [headers keywordize-headers?]
   (reduce (fn [m [k v]]
-            (assoc m (if keyify? (keyword (str/lower-case k))
+            (assoc m (if keywordize-headers? (keyword (str/lower-case k))
                          (str/lower-case k)) v))
           {} headers))

-(defn- http-method [method-keyword]
-  (case (or method-keyword :get)
-    :get HttpMethod/GET
-    :post HttpMethod/POST
-    :put HttpMethod/PUT))
+(defonce default-client (atom nil))

-(defn- generate-query-string
-  "Params: {:param1 \"value1\" :params2 \"value2\" :param3 [\"value3\" \"value4\"}
+(defn init-client "Initializes and returns a new HTTP client."
+  [& {:keys [timeout user-agent] :as default-request-opts
+      :or {timeout 40000 user-agent "http-kit/1.3"}}]
+  (HttpClient. (HttpClientConfig. timeout user-agent)))

-   Return Http Form encoded bytes array. used as HTTP body. Need to set
+(defn get-default-client "Returns default HTTP client, initializing as neccesary."
+  [] (if-let [c @default-client] c (reset! default-client (init-client))))

-   Content-Type: application/x-www-form-urlencoded
+(defn request*
+  "Issues an async HTTP request and returns a promise object to which the value
+  of `(callback <http-response>)` or `((or error-callback callback) <exception>)`
+  will be delivered. See also `request`."
+  [{:keys [client url method headers data timeout]
+    :or   {method :get client (get-default-client)}}
+   callback & [error-callback]]
+  (let [uri (URI. url)
+        method (case method
+                 :get  HttpMethod/GET
+                 :post HttpMethod/POST
+                 :put  HttpMethod/PUT)
+        response (promise)]
+    (.exec ^HttpClient client uri method headers data
+           (or timeout -1) ; -1 for client default
+           (RespListener.
+            (reify IResponseHandler
+              (onSuccess [this status headers body]
+                (deliver response
+                         (callback {:body body
+                                    :headers (normalize-headers headers true)
+                                    :status status})))
+              (onThrowable [this t]
+                (deliver response
+                         (try ((or error-callback callback) (Exception. t))
+                              (catch Exception e e)))))))
+    response))

-   in the Request's Headers for server to properly understand it"
-  [params]
-  (.getBytes (str/join "&"
-                       (mapcat (fn [[k v]]
-                                 (if (sequential? v)
-                                   (map #(str (url-encode (name %1))
-                                              "="
-                                              (url-encode (str %2)))
-                                        (repeat k) v)
-                                   [(str (url-encode (name k))
-                                         "="
-                                         (url-encode (str v)))]))
-                               params))
-             "UTF-8"))
+(defmacro request
+  "Issues an asynchronous HTTP request, binds the HTTP response or exception to
+  `resp`, then executes the given handler body in the context of that binding.
+  Returns a promise object to which the handler's return value will be delivered:
+
+     ;; Asynchronous
+     (request {:url \"http://www.cnn.com/\"}
+              {:keys [status body headers] :as resp}
+              (if status ; nil on exceptions
+                (do (println \"Body: \" body) body)
+                (do (println \"Exception: \" resp) resp)))
+
+     ;; Synchronous
+     @(request ...) or (deref (request ...) timeout-ms timeout-val)
+
+  See lower-level `request*` for options."
+  [options resp & handler]
+  `(request* ~options (fn [~resp] ~@handler)))
+
+(comment
+  @(request {:url "http://www.cnn.com/"}
+            {:keys [status body headers] :as resp}
+            (if status ; nil on exceptions
+              (do (println "Body: " body) body)
+              (do (println "Exceptiond: " resp) resp))))
+
+(comment ; TODO
+
+  (defn- url-encode
+    "Returns an UTF-8 URL encoded version of the given string."
+    [unencoded]
+    (URLEncoder/encode unencoded "UTF-8"))
+
+  (defn- generate-query-string
+    "Params: {:param1 \"value1\" :params2 \"value2\" :param3 [\"value3\" \"value4\"}
+
+    Return Http Form encoded bytes array. used as HTTP body. Need to set
+
+    Content-Type: application/x-www-form-urlencoded
+
+    in the Request's Headers for server to properly understand it"
+    [params]
+    (.getBytes (str/join "&"
+                         (mapcat (fn [[k v]]
+                                   (if (sequential? v)
+                                     (map #(str (url-encode (name %1))
+                                                "="
+                                                (url-encode (str %2)))
+                                          (repeat k) v)
+                                     [(str (url-encode (name k))
+                                           "="
+                                           (url-encode (str v)))]))
+                                 params))
+               "UTF-8")))


context.clj: added content-storage-dir

context.clj: added content-storage-dir

--- src/org/altlaw/util/context.clj
+++ src/org/altlaw/util/context.clj
@@ -42,6 +42,11 @@
   served via HTTP on www.altlaw.org" []
   (java.io.File. (str (altlaw-home) "/src/org/altlaw/www/static")))

+(defn content-storage-dir
+  "Root directory for large 'content' storage, files containing
+  arbitrary data." []
+  (java.io.File. (str (altlaw-home) "/var/content")))
+
 (defn solr-home
   "Solr home directory for running Solr instances."
   []


Fix invalid rss

Fix invalid rss

Closes #2069

--- frontend/changelog.cljs
+++ frontend/changelog.cljs
@@ -3,17 +3,25 @@

 (defn attr-text [item attr]
-  (.-textContent (xml/selectSingleNode item attr)))
+  (when-let [node (xml/selectSingleNode item attr)]
+    (.-textContent node)))

 (defn parse-item [item]
-  {:title (attr-text item "title")
-   :description (attr-text item "description")
-   :link (attr-text item "link")
-   :author (attr-text item "author")
-   :pubDate (attr-text item "pubDate")
-   :guid (attr-text item "guid")
-   :type (attr-text item "type")
-   :categories (map #(.-textContent %) (xml/selectNodes item "category"))})
+  (let [type (attr-text item "type")
+        ;; "type" was illegal RSS, now uses first category.
+        categories (map #(.-textContent %) (xml/selectNodes item "category"))
+        [type & categories] (if type (cons type categories) categories)
+        ;; author should be an email address, dc:creator can just be a name
+        author (or (attr-text item "author")
+                   (attr-text item "dc:creator"))]
+    {:title (attr-text item "title")
+     :description (attr-text item "description")
+     :link (attr-text item "link")
+     :author author
+     :pubDate (attr-text item "pubDate")
+     :guid (attr-text item "guid")
+     :type type
+     :categories categories}))

 (defn parse-changelog-document [xml-document-object]
   (let [items (xml/selectNodes xml-document-object "//item")]


Had to create a form of (get-status) which could return both the status and the resulting state.

--- src/main/clojure/plugboard/status.clj
+++ src/main/clojure/plugboard/status.clj
@@ -166,7 +166,7 @@
      :otherwise (throw (IllegalStateException.)))))

 ;; Ultimately returns [status state]
-(defn get-status-with-transition-trace [decision-map-overrides state]
+(defn get-status-with-state [decision-map-overrides state]
   (let [reverse-transition-trace (fn [state]
                  (if (contains? state :status-trace)
                    (assoc state :status-trace (reverse (:status-trace state)))
@@ -178,13 +178,5 @@
     ))

 (defn get-status [decision-map-overrides state]
-  (let [reverse-transition-trace (fn [state]
-                 (if (contains? state :status-trace)
-                   (assoc state :status-trace (reverse (:status-trace state)))
-                   state))
-        [status new-state]
-        (trampoline flow-step :B1 (merge default-decision-map decision-map-overrides) (reverse-transition-trace state))
-        ]
-    status
-    ))
-
+  (let [[status state] (get-status-with-state decision-map-overrides state)]
+    status))


First move to fix syntax errors in repl

First move to fix syntax errors in repl

Refers #29

--- src/main/clojure/vimclojure/nails.clj
+++ src/main/clojure/vimclojure/nails.clj
@@ -261,10 +261,16 @@
   (let [nspace (util/resolve-and-load-namespace nspace)]
     (binding [*ns* nspace]
       (try
-        (dorun (util/stream->seq *in*))
-        true
-        (catch Throwable e
-          false)))))
+        (let [eof (Object.)]
+          (loop [x nil]
+            (if (identical? x eof)
+              true
+              (recur (read *in* false eof)))))
+        (catch clojure.lang.LispReader$ReaderException exc
+          (let [e (.getCause exc)]
+            (if (= "EOF while reading" (.getMessage e))
+              false
+              (throw exc))))))))

 (defnail Complete
   "Usage: ng vimclojure.nails.Complete"


Removing lower case search concept ids which cause errors.

--- test/cmr/system_int_test/search/granule_search_test.clj
+++ test/cmr/system_int_test/search/granule_search_test.clj
@@ -365,8 +365,7 @@
            ;; Multiple values
            [gran1 gran2 gran3 gran4 gran5] [gran1-cid gran2-cid gran3-cid gran4-cid gran5-cid] {}
            [gran1 gran5] [gran1-cid gran5-cid] {:and false}
-           [] [gran1-cid gran5-cid] {:and true}
-           [] (s/lower-case gran1-cid) {:ignore-case false}))
+           [] [gran1-cid gran5-cid] {:and true}))

     (testing "search granule by echo granule id with aql"
       (are [items ids options]
@@ -376,8 +375,7 @@
            [gran1] gran1-cid {}
            [gran5] gran5-cid {}
            ;; Multiple values
-           [gran1 gran2 gran3 gran4 gran5] [gran1-cid gran2-cid gran3-cid gran4-cid gran5-cid] {}
-           [] (s/lower-case gran1-cid) {:ignore-case false}))
+           [gran1 gran2 gran3 gran4 gran5] [gran1-cid gran2-cid gran3-cid gran4-cid gran5-cid] {}))

     (testing "echo granule id search - disallow ignore case"
       (is (= {:status 422


Cosmetic fixes on canvas components.

Cosmetic fixes on canvas components.


Fix parentheses in latest games test assertion

--- test/nhl_score_api/fetchers/mlbam/latest_games_test.clj
+++ test/nhl_score_api/fetchers/mlbam/latest_games_test.clj
@@ -17,7 +17,7 @@
     (let [latest-games (:games
                          (filter-latest-started-games resources/games-in-live-preview-and-final-states))]
       (is (= ["Final" "Live" "Live"]
-             (map #(:abstract-game-state (:status %)) latest-games))) "Game states"))
+             (map #(:abstract-game-state (:status %)) latest-games)) "Game states")))

   (testing "No started games is handled gracefully"
     (let [latest-games (:games


Add missing quotation mark.

Add missing quotation mark.

--- src/cli4clj/example.clj
+++ src/cli4clj/example.clj
@@ -61,7 +61,7 @@
 ;;;                      The command is intended to take a seq (e.g., a list or vector) which it converts into a CSV string.
                          :to-csv {:fn (fn [data] (reduce (fn [s d] (str s "," d)) (str (first data)) (rest data)))
                                   :short-info "Seq to CSV"
-                                  :long-info "E.g.: \"to-csv [1 2 3]\"}
+                                  :long-info "E.g.: \"to-csv [1 2 3]\""}
                         }
                  }]
 ;;;  Last but not least, the CLI is started using the options defined above.


startup stuff

startup stuff

--- src/clj/signet/core.clj
+++ src/clj/signet/core.clj
@@ -47,9 +47,9 @@

 (defn -main [& args]
   (let [port (-> args first read-string)]
-    (info " - SERVER - Warming up...")
+    (info "SERVER - Warming up...")
     (run-server (site #'handler) {:port (or port 8082) :join? false})
-    (info " - SERVER - started")
+    (info "SERVER - running!")
     (info  (str "Visit http://localhost:" (or port 8082)))))

@@ -151,4 +151,5 @@

+
   )


Add missing transactions

Add missing transactions

--- src/cljc/mdr2/i18n.cljc
+++ src/cljc/mdr2/i18n.cljc
@@ -38,6 +38,8 @@
                     :finished "Finished"
                     ;;
                     :dam "DAM"
+                    :id "DAM Number"
+                    :identifier "Identifier"
                     :title "Title"
                     :creator "Author"
                     :source_publisher "Source Publisher"
@@ -59,8 +61,9 @@
                     :publisher "Publisher"
                     :revision "Revision"
                     :source "Source"
-                    :volumes "Volumes"
-                    :depth "Depth"
+                    :volumes "Number of Volumes"
+                    :depth "Number of levels"
+                    :production_type "Type of production"
                     ;;
                     :transitions-state "Transition state to '%1'"
                     :upload-structure "Upload structure for '%1' (DAM %2)"
@@ -120,6 +123,8 @@
                     :finished "Fertig"
                     ;;
                     :dam "DAM"
+                    :id "DAM Nummer"
+                    :identifier "Identifier"
                     :title "Titel"
                     :creator "Autor"
                     :source_publisher "Verlag"
@@ -136,13 +141,14 @@
                     :language "Sprache"
                     :spelling "Rechtschreibung"
                     :date "Datum"
+                    :modified-at "Letzte Änderung"
                     :format "Format"
                     :publisher "Verlag"
                     :revision "Revision"
                     :source "Source"
-                    :volumes "Volumes"
-                    :depth "Depth"
-                    :modified-at "Letzte Änderung"
+                    :volumes "Anzahl Bände"
+                    :depth "Anzahl Levels"
+                    :production_type "Art der Produktion"
                     ;;
                     :transitions-state "Status auf '%1' setzen"
                     :upload-structure "Struktur Datei für '%1' (DAM %2) hochladen"


optimize various types of key scans so we don't pay for higher order fn usage

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -3954,25 +3954,40 @@

 ;;; PersistentArrayMap

-(defn- equiv-nil [k k']
-  (nil? k'))
-
-(defn- equiv-pred [x]
-  (cond
-    ^boolean (goog/isString x) identical?
-    (nil? x) equiv-nil
-    (number? x) identical?
-    :else =))
-
-(defn- array-map-index-of [m k]
-  (let [arr  (.-arr m)
-        len  (alength arr)
-        pred (equiv-pred k)]
+(defn- array-map-index-of-nil? [arr m k]
+  (let [len (alength arr)]
     (loop [i 0]
       (cond
         (<= len i) -1
-        ^boolean (pred k (aget arr i)) i
+        (nil? (aget arr i)) i
         :else (recur (+ i 2))))))
+
+(defn- array-map-index-of-identical? [arr m k]
+  (let [len (alength arr)]
+    (loop [i 0]
+      (cond
+        (<= len i) -1
+        (identical? k (aget arr i)) i
+        :else (recur (+ i 2))))))
+
+(defn- array-map-index-of-equiv? [arr m k]
+  (let [len (alength arr)]
+    (loop [i 0]
+      (cond
+        (<= len i) -1
+        (= k (aget arr i)) i
+        :else (recur (+ i 2))))))
+
+(defn- array-map-index-of [m k]
+  (let [arr (.-arr m)]
+    (cond
+      (or ^boolean (goog/isString k) (number? k))
+      (array-map-index-of-identical? arr m k)
+
+      (nil? k)
+      (array-map-index-of-nil? arr m k)
+
+      :else (array-map-index-of-equiv? arr m k))))

 (defn- array-map-extend-kv [m k v]
   (let [arr (.-arr m)


CLJS-368: Make empty? faster for nil calls.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -905,7 +905,8 @@
 (defn ^boolean empty?
   "Returns true if coll has no items - same as (not (seq coll)).
   Please use the idiom (seq x) rather than (not (empty? x))"
-  [coll] (not (seq coll)))
+  [coll] (or (nil? coll)
+             (not (seq coll))))

 (defn ^boolean coll?
   "Returns true if x satisfies ICollection"


* src/cljs/cljs/core.cljs: add ifn?

* src/cljs/cljs/core.cljs: add ifn?

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -684,6 +684,9 @@

 (defn fn? [f]
   (goog/isFunction f))
+
+(defn ifn? [f]
+  (or (fn? f) (satisfies? IFn f)))

 (defn integer?
   "Returns true if n is an integer.  Warning: returns true on underflow condition."


Add support for Text & Font functions.

Add support for Text & Font functions.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -3949,7 +3949,6 @@
   ([^String s x y z] (.text (current-graphics) s (float x) (float y) (float z)))
   ([^String s x1 y1 x2 y2] (.text (current-graphics) s (float x1) (float y1) (float x2) (float y2))))

-#+clj
 (defn
   ^{:requires-bindings true
     :processing-name "textAlign()"
@@ -4015,7 +4014,6 @@
   []
   (.textDescent (current-graphics)))

-#+clj
 (defn
   ^{:requires-bindings true
     :processing-name "textFont()"
@@ -4054,7 +4052,6 @@
   [leading]
   (.textLeading (current-graphics) (float leading)))

-#+clj
 (defn
   ^{:requires-bindings true
     :processing-name "textMode()"
@@ -4151,7 +4148,6 @@
   (let [mode (resolve-constant-key mode texture-wrap-modes)]
     (.textureWrap (current-graphics) mode)))

-#+clj
 (defn
   ^{:requires-bindings true
     :processing-name "textWidth()"


Replace defrecord for connection and async connection wity reify.

--- src/clojure/nanomsg.clj
+++ src/clojure/nanomsg.clj
@@ -62,68 +62,73 @@
   (recv-bytes! [_] [_ blocking] "Receive bytes using socket.")
   (close! [_] "Close a socket."))

-(defrecord Connection [s]
-  INNSocket
-  (bind! [_ endpoint]
-    (.bind s endpoint))
-  (connect! [_ endpoint]
-    (.connect s endpoint))
-  (subscribe! [_ pattern]
-    (.subscribe s pattern))
-  (unsubscribe! [_ pattern]
-    (.unsubscribe s pattern))
-  (recv-bytes! [_]
-    (.recvBytes s))
-  (recv-bytes! [_ blocking]
-    (.recvBytes s blocking))
-  (recv! [_]
-    (.recvString s))
-  (send! [_ data]
-    (.send s data))
-  (send! [_ data blocking]
-    (.send s data blocking))
-  (recv! [_ blocking]
-    (.recvString s blocking))
-  (close! [_]
-    (.close s))
+(defn- async-socket
+  [^Socket socket ^AsyncSocket asocket]
+  (reify
+    INNSocket
+    (bind! [_ endpoint]
+      (.bind socket endpoint))
+    (connect! [_ endpoint]
+      (.connect socket endpoint))
+    (subscribe! [_ pattern]
+      (.subscribe socket pattern))
+    (unsubscribe! [_ pattern]
+      (.unsubscribe socket pattern))
+    (recv! [_]
+      (throw (UnsupportedOperationException.
+              "Unsuporded arity for async connection.")))
+    (recv-bytes! [_]
+      (throw (UnsupportedOperationException.
+              "Unsuporded arity for async connection.")))
+    (send! [_ data]
+      (throw (UnsupportedOperationException.
+              "Unsuporded arity for async connection.")))
+    (send! [_ data continuation]
+      (let [cb (->async-callback continuation)]
+        (.send asocket data cb)))
+    (recv! [_ continuation]
+      (let [cb (->async-callback continuation)]
+        (.recvString asocket cb)))
+    (recv-bytes! [_ continuation]
+      (let [cb (->async-callback continuation)]
+        (.recvBytes asocket cb)))
+    (close! [_]
+      (.close socket))

-  java.io.Closeable
-  (close [_]
-    (.close s)))
+    java.io.Closeable
+    (close [_]
+      (.close socket))))

-(defrecord AsyncConnection [s px]
-  INNSocket
-  (bind! [_ endpoint]
-    (.bind s endpoint))
-  (connect! [_ endpoint]
-    (.connect s endpoint))
-  (subscribe! [_ pattern]
-    (.subscribe s pattern))
-  (unsubscribe! [_ pattern]
-    (.unsubscribe s pattern))
-  (recv-bytes! [_]
-    (let [ch (chan)
-          cb (make-iasynccallback ch)]
-      (.recvBytes px cb)
-      ch))
-  (send! [_ data]
-    (let [ch (chan)
-          cb (make-iasynccallback ch)]
-      (.send px data cb)
-      ch))
-  (recv! [_]
-    (let [ch (chan)
-          cb (make-iasynccallback ch)]
-      (.recvString px cb)
-      ch))
-  (close! [_]
-    (.close s))
-  (send! [_ data blocking]
-    (throw (UnsupportedOperationException. "Unsuporded arity for async connection.")))
-  (recv! [_ blocking]
-    (throw (UnsupportedOperationException. "Unsuporded arity for async connection.")))
-  (recv-bytes! [_ blocking]
-    (throw (UnsupportedOperationException. "Unsuporded arity for async connection."))))
+(defn- blocking-socket
+  [^Socket socket]
+  (reify
+    INNSocket
+    (bind! [_ endpoint]
+      (.bind socket endpoint))
+    (connect! [_ endpoint]
+      (.connect socket endpoint))
+    (subscribe! [_ pattern]
+      (.subscribe socket pattern))
+    (unsubscribe! [_ pattern]
+      (.unsubscribe socket pattern))
+    (recv-bytes! [_]
+      (.recvBytes socket))
+    (recv-bytes! [_ blocking]
+      (.recvBytes socket blocking))
+    (recv! [_]
+      (.recvString socket))
+    (send! [_ data]
+      (.send socket data))
+    (send! [_ data blocking]
+      (.send socket data blocking))
+    (recv! [_ blocking]
+      (.recvString socket blocking))
+    (close! [_]
+      (.close socket))
+
+    java.io.Closeable
+    (close [_]
+      (.close socket))))

 (defn socket
   "Geiven a socket type, create a new instance


Only force tools.logging to use log4j if available [IMMUTANT-449]

--- namespaces/common/src/main/clojure/immutant/logging.clj
+++ namespaces/common/src/main/clojure/immutant/logging.clj
@@ -33,8 +33,11 @@
   (delay
     (try
       (require 'clojure.tools.logging)
-      (eval '(alter-var-root #'clojure.tools.logging/*logger-factory*
-               (constantly (clojure.tools.logging.impl/log4j-factory))))
+      (try
+        (import 'org.apache.log4j.Logger)
+        (eval '(alter-var-root #'clojure.tools.logging/*logger-factory*
+                 (constantly (clojure.tools.logging.impl/log4j-factory))))
+        (catch ClassNotFoundException _))
       true
       (catch java.io.FileNotFoundException _))))


More async.

More async.

--- src/datascript/core.cljs
+++ src/datascript/core.cljs
@@ -25,12 +25,10 @@
 ;;;;;;;;;; Searching

-(defn- slice-it [index search]
-  (let [search-start search
+(defn- slice-it [index search callback]
+  (callback (let [search-start search
         search-stop  (mapv #(if (nil? %) "\uffff" %) search)]
-    (println "slice-it" index search search-start search-stop)
-    (println "slice-it" (vals (subseq index >= search-start <= search-stop)))
-    (vec (vals (subseq index >= search-start <= search-stop)))))
+    (vec (vals (subseq index >= search-start <= search-stop))))))

 (defprotocol ISearch
   (-search [data pattern callback]))
@@ -45,16 +43,16 @@

   ISearch
   (-search [_ [e a v] callback]
-    (callback (case-tree [e a (some? v)] [
-      (slice-it eav [e a v])                ;; e a v
-      (slice-it eav [e a nil])              ;; e a _
-      (->> (slice-it eav [e nil nil])       ;; e _ v
-           (filter #(= v (.-v %))))
-      (slice-it eav [e nil nil])            ;; e _ _
-      (slice-it ave [a v nil])              ;; _ a v
-      (slice-it ave [a nil nil])            ;; _ a _
-      (filter #(= v (.-v %)) eav)           ;; _ _ v
-      eav])))                               ;; _ _ _
+    (case-tree [e a (some? v)] [
+      (slice-it eav [e a v] callback)                ;; e a v
+      (slice-it eav [e a nil] callback)              ;; e a _
+      (slice-it eav [e nil nil] (fn [data]
+        (callback (filter #(= v (.-v %)) data))))    ;; e _ v
+      (slice-it eav [e nil nil] callback)            ;; e _ _
+      (slice-it ave [a v nil] callback)              ;; _ a v
+      (slice-it ave [a nil nil] callback)            ;; _ a _
+      (callback (filter #(= v (.-v %)) eav))         ;; _ _ v
+      (callback eav)]))                              ;; _ _ _

   Idb
   (add-record [_ e a v]


(maint) Don't copy dotfiles for config staging

If one were editing a config file and then ran `lein stage`, the dotfile
would be included in the copy that was turned into a project. This would
pose a problem when the Makefile template was evaluated, as it lists all
config files (including dotfiles) to be explicitly copied. The packaging
would then ignore the dotfiles and the build would fail trying to copy a
dotfile that didn't make it into the tarball. This commit prevents that
by never copying dotfiles in the configs directory into the staging
directory.

--- src/puppetlabs/ezbake/stage.clj
+++ src/puppetlabs/ezbake/stage.clj
@@ -49,7 +49,9 @@
           (every? #(instance? File %) %)]}
   (let [dir   (first iter-entry)
         files (get iter-entry 2)]
-    (map #(fs/file dir %) files)))
+    (->> files
+         (remove (partial re-find #"^\."))
+         (map #(fs/file dir %)))))

 (defn find-files-recursively
   "Given a File object representing a directory, walks the directory (recursively)


still squashing typecasting bug

still squashing typecasting bug

--- src/push/types/base/integer.clj
+++ src/push/types/base/integer.clj
@@ -90,7 +90,7 @@
     integer-fromchar
     :tags #{:base :conversion}
     (d/consume-top-of :char :as :arg1)
-    (d/calculate [:arg1] #(bigint %1) :as :int)
+    (d/calculate [:arg1] #(long %1) :as :int)
     (d/push-onto :integer :int)))


Reuse render function between components

--- src/reagent/impl/component.cljs
+++ src/reagent/impl/component.cljs
@@ -61,6 +61,13 @@

 ;;; Method wrapping

+(def static-fns {:render
+                 (fn []
+                   (this-as c
+                            (if-not *non-reactive*
+                              (batch/run-reactively c #(do-render c))
+                              (do-render c))))})
+
 (defn custom-wrapper [key f]
   (case key
     :getDefaultProps
@@ -154,11 +161,7 @@
 (defn add-render [fun-map render-f]
   (assoc fun-map
     :cljsRender render-f
-    :render (if-not *non-reactive*
-              (fn []
-                (this-as c
-                         (batch/run-reactively c #(do-render c))))
-              (fn [] (this-as c (do-render c))))))
+    :render (:render static-fns)))

 (defn wrap-funs [fun-map]
   (let [render-fun (or (:componentFunction fun-map)


update

update

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -269,14 +269,20 @@

 (defn mapc [dataset fs]
 "Takes an array or a hashmap of functions and maps each to the key column for every row."
-  (let [functions (if (vector? fs)
+  (let [fs-hash (if (vector? fs)
                     (zipmap (column-names dataset) fs)
-                    fs)]
+                    fs)
+        other-keys (vec (clojure.set/difference (set (:column-names dataset))
+                                                      (set (if (sequential? key-cols)
+                                                               key-names
+                                                               [key-names]))))]
     (->> dataset
          (map (fn [row]
                 (map (fn [f c] (f c))
-                     (lazy-cat fs (cycle [identity])) row)))
-         (map (partial apply vector)))))
+                     (conj functions (zipmap ;;identity)) row)))
+         ;(map (partial apply vector))
+         )
+    ))

 (comment


Clojure's reader does allow ' in symbols


Fixed justification.

Fixed justification.

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -50,7 +50,7 @@
 (defn fill-column [ts l]
   (let [f (fn [terms-so-far term]
             (if (>= (apply + (map count terms-so-far)) l)
-              (reduced terms-so-far)
+              (reduced (if (> (count terms-so-far) 1) (butlast terms-so-far) terms-so-far))
               (conj terms-so-far term)))
         terms-that-fit (reduce f [(first ts)] (rest ts))
         ts-rest (drop (count terms-that-fit) ts)]


re naming, and refactoring

re naming, and refactoring

--- exercises/poker/src/example.clj
+++ exercises/poker/src/example.clj
@@ -1,28 +1,27 @@
 (ns poker
   (:require [clojure.string :as cs]))

-(defn times [x xs]
-  (count (filter #{x} xs)))
-
 (defn rank-hand [hand]
-  (let [h   (cs/split (cs/replace hand #"10" "T") #" ")
-        r   (map #(.indexOf (seq "..23456789TJQKA") (first %)) h)
-        nr  (distinct r)
-        gs  (reverse (sort-by vec (map vector (map #(times % r) nr) nr)))
-        cs  (mapv first gs)
-        rs  (if (= (mapv second gs) [14,5,4,3,2]) [5,4,3,2,1] (mapv second gs))
-        srt (and (= 5 (count cs)) (= 4 (- (apply max cs) (apply min cs))))
-        fsh (= 1 (count (distinct (map last h))))]
-    (cond (= 5 cs)         [9 rs]
-          (and srt fsh)    [8 rs]
-          (= cs [4 1])     [7 rs]
-          (= cs [3 2])     [6 rs]
-          fsh              [5 rs]
-          srt              [4 rs]
-          (= cs [3 1 1])   [3 rs]
-          (= cs [2 2 1])   [2 rs]
-          (= cs [2 1 1 1]) [1 rs]
-          :else            [0 rs])))
+  (let [h (cs/split (cs/replace hand #"10" "T") #" ")
+        initial-ranks (map #(.indexOf (seq "..23456789TJQKA") (first %)) h)
+        score-frec (reverse (sort-by vec (map (comp vec reverse)
+                                              (frequencies initial-ranks))))
+        rank-counts (mapv first score-frec)
+        normalized-ranks (if (= (mapv second score-frec) [14,5,4,3,2]) [5,4,3,2,1]
+                             (mapv second score-frec))
+        straight? (and (= 5 (count rank-counts))
+                       (= 4 (- (apply max rank-counts) (apply min rank-counts))))
+        flush? (= 1 (count (distinct (map last h))))]
+    (cond (= 5 rank-counts)         [9 normalized-ranks]
+          (and straight? flush?)    [8 normalized-ranks]
+          (= rank-counts [4 1])     [7 normalized-ranks]
+          (= rank-counts [3 2])     [6 normalized-ranks]
+          flush?                    [5 normalized-ranks]
+          straight?                 [4 normalized-ranks]
+          (= rank-counts [3 1 1])   [3 normalized-ranks]
+          (= rank-counts [2 2 1])   [2 normalized-ranks]
+          (= rank-counts [2 1 1 1]) [1 normalized-ranks]
+          :else                     [0 normalized-ranks])))

 (defn greater-than [xs ys]
   (or (> (first xs) (first ys))
@@ -31,12 +30,13 @@
            (some (partial = 1)))))

 (defn best-hands [hands]
-  (loop [m [0 []], r [], hs hands]
-    (if (empty? hs)
-      r
-      (let [[x xs] ((juxt first rest) hs)
-            rank   (rank-hand x)]
-        (cond
-          (or (empty? r) (greater-than rank m)) (recur rank [x] xs)
-          (= rank m)                            (recur m (conj r x) xs)
-          :else                                 (recur m r xs))))))
+  (-> (fn [[max-rank record hands]]
+        (let [[x & xs] hands
+              rank     (rank-hand x)]
+           (cond
+             (or (empty? record) (greater-than rank max-rank)) [rank [x] xs]
+             (= rank max-rank) [max-rank (conj record x) xs]
+             :else [max-rank record xs])))
+      (iterate  [[0 []] [] hands])
+      (nth (count hands))
+      (second)))


Настрока  files-root-directory

Настрока  files-root-directory

--- src/ixinfestor/core.clj
+++ src/ixinfestor/core.clj
@@ -1,5 +1,5 @@
 (ns ixinfestor.core
-
+
   (:use korma.db)
   (:use korma.core)
   (:use clojure.pprint)
@@ -433,12 +433,14 @@
 ;;* description: Хранение файлов
 ;;*
 ;;**************************************************************************************************
-
-(def files-root-directory "files_root_directory")
+(def files-root-directory (promise))
+

 (defn save-file [tempfile dir filename]
-  (let [dir-filename (str dir filename)
-        full-path (str files-root-directory dir-filename)]
+  (let [dir-filename (str dir "/" filename)
+        full-path (str (if (realized? files-root-directory) @files-root-directory
+                           (throw (Exception. "Значение пути  files-root-directory еще не задано")))
+                       "/" dir-filename)]
     (clojure.java.io/make-parents full-path)
     (with-open [in (clojure.java.io/input-stream tempfile)
                 out (clojure.java.io/output-stream full-path)]
@@ -469,7 +471,7 @@
                                   (assoc :path "?TMP?")
                                   files-save)
          path (save-file tempfile
-                         (str (tf/unparse (tf/formatter-local "/yyyy/MM/dd/") (tl/local-now)) id "/")
+                         (str (tf/unparse (tf/formatter-local "yyyy/MM/dd/") (tl/local-now)) id)
                          (file-row :filename))]
      (-> new-row
          (assoc :path path)
@@ -506,6 +508,3 @@

 ;; END files entity
 ;;..................................................................................................
-
-
-


Fix uri error

Fix uri error

--- src/kixi/hecuba/web.clj
+++ src/kixi/hecuba/web.clj
@@ -67,7 +67,7 @@

       ["projects/" projects]
       ["projects" (->Redirect 307 projects)]
-      [["projects/" :id] project]
+      [["project/" :id] project]

       ;; Static resources
       [(->Alternates ["stylesheets/" "images/" "javascripts/"])


Add index batch-update notes.

Add index batch-update notes.

--- src/merkle_db/index.clj
+++ src/merkle_db/index.clj
@@ -176,8 +176,8 @@
 ;; are index nodes. In a tree with branching factor `b`, every index node
 ;; except the root must have between `ceiling(b/2)` and `b` children. The root
 ;; is allowed to have between 2 and `b` children. If the tree has more than
-;; `::partition/limit` records, then each partition in the tree will be at
-;; least half full.
+;; `:merkle-db.partition/limit` records, then each partition in the tree will
+;; be at least half full.
 ;;
 ;; The root node may be:
 ;; - nil, indicating an empty tree.
@@ -185,39 +185,153 @@
 ;;   than `::partition/limit` records.
 ;; - An index, which is treated as the root node of the tree.
 ;;
-;; In the first "downward" phase, changes are grouped by the child which links
-;; to the subtree containing the updated keys. Once the changes reach the leaf
-;; partitions, apply them to produce some result partitions, in order.
-;; - If zero partitions (all deleted), remove the original child link and key
-;;   from the parent node.
-;; - If one partition, update the original child link and key.
-;; - If multiple partitions (split), insert the additional child links and keys into the parent node
-;; - If any partitions (across the tree) underflowed, merge with or borrow from siblings.
-
-;; Insertion
-;;
-;; - Perform a search to determine what partition the new record should go into.
-;; - If the partition is not full (at most p entries after the insertion), add the record.
-;; - Otherwise, split the partition.
-;;     - Split half the partition's elements into a new partition.
-;;     - Insert the new partition's smallest key and link into the parent.
-;;     - If the parent is full, split it too.
-;;         - Add the middle key to the parent node.
-;;     - Repeat until a parent is found that need not split.
-;; - If the root splits, create a new root which has one key and two links.
-;;   (That is, the value that gets pushed to the new root gets removed from
-;;   the original node)
-
-;; Deletion
-;;
-;; - Start at root, find partition P where record belongs.
-;; - Remove the record.
-;;     - If P is at least half-full, done!
-;;     - If P has fewer entries than it should,
-;;         - If sibling (adjacent node with same parent as P) is more than half-full, re-distribute, borrowing an record from it.
-;;         - Otherwise, sibling is exactly half-full, so we can merge P and sibling.
-;; - If merge occurred, must delete record (pointing to P or sibling) from parent of P.
-;; - Merge could propagate to root, decreasing height.
+;; At each node, the update proceeds in a number of phases. The algorithm
+;; described below uses three terms for nodes:
+;; - The "parent" is the current top level node we're recursing on.
+;; - The "children" are the direct descendants of the parent node.
+;; - The "candidates" are changed but unstored descendant nodes.
+
+
+;; ### Divide Changes
+;;
+;; In the first **downward** phase, changes at the parent are grouped by the
+;; child which links to the subtree containing the referenced keys.
+
+,,,
+
+
+;; ### Apply Changes
+;;
+;; In the **apply** phase, changes are applied to the _children_ to produce
+;; new child nodes. This call returns an unpersisted candidate, or nil if the
+;; resulting node would be empty. The resulting candidate node may have any
+;; number of children, meaning it can either underflow, be valid, or overflow,
+;; depending on the changes applied.
+
+,,,
+
+
+;; ### Redistribute Children
+;;
+;; In the **distribution** phase, any candidate children which have over or
+;; overflowed must split, merge with a neighbor, or borrow some elements from
+;; one. Afterwards, all children should be at least half full and under the
+;; size limit, unless there is only a single child left.
+;;
+;; Consider consecutive runs of invalid candidate nodes; if the total number of
+;; children is at least half the limit, repartition the children into a number
+;; of valid nodes. Otherwise, resolve the last link before the run and add it
+;; to the pool to redistribute. Use the link after if the run includes the
+;; first child.
+
+; TODO: what to do in the exceptional case that there is only a single child left?
+
+; Seems like it needs a 'zipper' phase to re-merge. Say a series of changes has
+; left us in this state with a tree with b=4. O is an unchanged node, * is a
+; candidate:
+; >      *
+;       / \
+;      /   \
+;     *     *
+;    /     / \
+;   *     *   O
+;   |    /|\  |\
+;   *   O * O O O
+
+; Now we've propagated up to the root, and we see that the left child is
+; underflowing, so merge it into the right child:
+;        *
+;        |
+;        |
+; >    .-*-.
+;     /  |  \
+;    *   *   O
+;    |  /|\  |\
+;    * O * O O O
+
+; The check continues recursively, and the new merged node checks its children.
+; Again, the left node needs to be merged in:
+;        *
+;        |
+;        |
+;        *.
+;       /  \
+; >   .*.   O
+;    // \\  |\
+;   * O * O O O
+
+; The final node is valid with 4 children, so we can start serializing the
+; children:
+;        *
+;        |
+;        |
+;        *.
+;       /  \
+;     .*.   O
+;    // \\  |\
+; > + O + O O O
+
+;        *
+;        |
+;        |
+;        *.
+;       /  \
+; >   .+.   O
+;    // \\  |\
+;   + O + O O O
+
+;        *
+;        |
+;        |
+; >      +.
+;       /  \
+;     .+.   O
+;    // \\  |\
+;   + O + O O O
+
+; If the upward recursion reaches a branch with a single child, we're on a path
+; up to the root, so return the subtree directly, decreasing the height of the
+; tree.
+; >      *
+;        |
+;        |
+;        +.
+;       /  \
+;     .+.   O
+;    // \\  |\
+;   + O + O O O
+
+; Resulting balanced tree:
+;        +.
+;       /  \
+;     .+.   O
+;    // \\  |\
+;   + O + O O O
+
+,,,
+
+
+;; ### Flush Candidates
+;;
+;; After the merge, the first child should have all fully valid candidates.
+;; Serialize the candidates and replace them with links. Update the child
+;; node's height and record count as needed. Flushing proceeds to each child
+;; node in turn until all candidates have been serialized and are valid nodes,
+;; completing that layer of the tree.
+
+;; ### Update Parent
+;;
+;; If the number of children is higher than the limit, the node has
+;; _overflowed_, and is split to return a sequence of valid nodes which are at
+;; least half full. Otherwise, a sequence containing a single updated node
+;; candidate is returned. If every child was deleted, an empty sequence is
+;; returned.
+;;
+;; Propagate the changes up to the top of the index tree, creating new layers
+;; as necessary to accommodate child splits.
+;;
+;; ...
+

 ;; References
 ;;


[refactor] factor out locals to preds

[refactor] factor out locals to preds

--- src/mranderson/move.clj
+++ src/mranderson/move.clj
@@ -75,38 +75,35 @@
   (= node-sexpr old-sym))

 (defn- prefix?
-  [node-sexpr old-name-prefix]
-  (str/starts-with? node-sexpr old-name-prefix))
+  [node-sexpr old-sym]
+  (let [old-name-prefix (str (name old-sym) "/")]
+    (str/starts-with? node-sexpr old-name-prefix)))

 (defn- kw-prefix?
-  [node-sexpr old-name-kw-prefix]
-  (str/starts-with? node-sexpr old-name-kw-prefix))
+  [node-sexpr old-sym]
+  (let [old-name-kw-prefix (str ":" (str (name old-sym) "/"))]
+    (str/starts-with? node-sexpr old-name-kw-prefix)))

 (defn- libspec-prefix?
-  [parent-leftmost-sexpr node-sexpr old-sym-prefix-libspec]
-  (and (= :require parent-leftmost-sexpr)
-       (= node-sexpr old-sym-prefix-libspec)))
+  [parent-leftmost-sexpr node-sexpr old-sym]
+  (let [old-sym-prefix-libspec (prefix-libspec old-sym)]
+    (and (= :require parent-leftmost-sexpr)
+         (= node-sexpr old-sym-prefix-libspec))))

 (defn- contains-sym? [old-sym node]
-  (let [old-name-prefix        (str (name old-sym) "/")
-        old-name-kw-prefix     (str ":" old-name-prefix)
-        old-sym-prefix-libspec (prefix-libspec old-sym)]
-    (when-not (#{:uneval} (b/tag node))
-      (when-let [node-sexpr (b/sexpr node)]
-        (let [parent-leftmost-node (z/leftmost (z/up node))
-              parent-leftmost-sexpr (and parent-leftmost-node
-                                         (not
-                                          (#{:uneval}
-                                           (b/tag parent-leftmost-node)))
-                                         (b/sexpr parent-leftmost-node))]
-          (or
-           (sexpr= node-sexpr old-sym)
-           (libspec-prefix?
-            parent-leftmost-sexpr
-            node-sexpr
-            old-sym-prefix-libspec)
-           (prefix? node-sexpr old-name-prefix)
-           (kw-prefix? node-sexpr old-name-kw-prefix)))))))
+  (when-not (#{:uneval} (b/tag node))
+    (when-let [node-sexpr (b/sexpr node)]
+      (let [parent-leftmost-node  (z/leftmost (z/up node))
+            parent-leftmost-sexpr (and parent-leftmost-node
+                                       (not
+                                        (#{:uneval}
+                                         (b/tag parent-leftmost-node)))
+                                       (b/sexpr parent-leftmost-node))]
+        (or
+         (sexpr= node-sexpr old-sym)
+         (libspec-prefix? parent-leftmost-sexpr node-sexpr old-sym)
+         (prefix? node-sexpr old-sym)
+         (kw-prefix? node-sexpr old-sym))))))

 (defn- replace-in-node [old-sym new-sym old-node]
   (let [old-prefix (prefix-libspec old-sym)


add store to utils

add store to utils

--- labs/architecture-examples/om/src/todomvc/utils.cljs
+++ labs/architecture-examples/om/src/todomvc/utils.cljs
@@ -1,4 +1,5 @@
 (ns todomvc.utils
+  (:require [clojure.reader :as reader])
   (:import [goog.ui IdGenerator]))

 (defn guid []
@@ -11,3 +12,13 @@
   (if (== n 1)
     word
     (str word "s")))
+
+(defn store
+  ([ns] (store ns nil))
+  ([ns edn]
+    (if-not (nil? edn)
+      (.setItem js/localStorage (str edn))
+      (let [s (.getItem js/localStorage ns)]
+        (if-not (nil? s)
+          (reader/read-string s)
+          [])))))


CMR-1050: Finishing updates for code comments.

--- metadata-db-app/src/cmr/metadata_db/api/concepts.clj
+++ metadata-db-app/src/cmr/metadata_db/api/concepts.clj
@@ -12,19 +12,19 @@
 (defn as-int
   "Parses the string to return an integer"
   [^String v]
-  (when v (Integer. v)))
+  (try
+    (when v (Integer. v))
+    (catch NumberFormatException e
+      (serv-err/throw-service-error :invalid-data (.getMessage e)))))

 (defn- get-concept
   "Get a concept by concept-id and optional revision"
   ([context params concept-id]
    (get-concept context params concept-id nil))
   ([context params concept-id revision]
-   (try
-     {:status 200
-      :body (rh/to-json (concept-service/get-concept context concept-id (as-int revision)) params)
-      :headers rh/json-header}
-     (catch NumberFormatException e
-       (serv-err/throw-service-error :invalid-data (.getMessage e))))))
+   {:status 200
+    :body (rh/to-json (concept-service/get-concept context concept-id (as-int revision)) params)
+    :headers rh/json-header}))

 (defn- allow-missing?
   "Returns true if the allow_missing parameter is set to true"
@@ -79,25 +79,19 @@
 (defn- delete-concept
   "Mark a concept as deleted (create a tombstone)."
   [context params concept-id revision-id]
-  (try
-    (let [{:keys [revision-id]} (concept-service/delete-concept
-                                  context concept-id (as-int revision-id))]
-      {:status 200
-       :body (rh/to-json {:revision-id revision-id} params)
-       :headers rh/json-header})
-    (catch NumberFormatException e
-      (serv-err/throw-service-error :invalid-data (.getMessage e)))))
+  (let [{:keys [revision-id]} (concept-service/delete-concept
+                                context concept-id (as-int revision-id))]
+    {:status 200
+     :body (rh/to-json {:revision-id revision-id} params)
+     :headers rh/json-header}))

 (defn- force-delete
   "Permanently remove a concept version from the database."
   [context params concept-id revision-id]
-  (try
-    (let [{:keys [revision-id]} (concept-service/force-delete context concept-id (as-int revision-id))]
-      {:status 200
-       :body (rh/to-json {:revision-id revision-id} params)
-       :headers rh/json-header})
-    (catch NumberFormatException e
-      (serv-err/throw-service-error :invalid-data (.getMessage e)))))
+  (let [{:keys [revision-id]} (concept-service/force-delete context concept-id (as-int revision-id))]
+    {:status 200
+     :body (rh/to-json {:revision-id revision-id} params)
+     :headers rh/json-header}))

 (defn- get-concept-id
   "Get the concept id for a given concept."


Implement Redis backend functions

Implement Redis backend functions

--- src/photon/db/redis.clj
+++ src/photon/db/redis.clj
@@ -4,76 +4,66 @@
   (:import (redis.embedded RedisServer)))

 (def chunk-size 1000)
-(def instances (ref {}))
-(def streams (ref {}))
+(def instances (atom {}))

 (defn redis-conn [db-hazelcast]
-  (dosync
-   (if-let [instance (get @instances db-hazelcast)]
-     instance
-     (let [port (int (+ 10000 (* 1000 (Math/random))))
-           rs (RedisServer. port)
-           pool {:pool {} :spec {:host "127.0.0.1" :port port}}]
-       (dosync (alter instances
-                      assoc db-hazelcast {:rs rs :conn pool}))))))
+  (if-let [instance (get @instances db-hazelcast)]
+    instance
+    (let [port (int (+ 10000 (* 1000 (Math/random))))
+          rs (RedisServer. port)
+          pool {:pool {} :spec {:host "127.0.0.1" :port port}}
+          new-instance {:rs rs :conn pool}]
+      (swap! instances assoc db-hazelcast new-instance)
+      (.start rs)
+      new-instance)))

-(defrecord DBHazelcast [conf]
+(defrecord DBRedis [conf]
   db/DB
   (db/driver-name [this] "hazelcast")
   (db/fetch [this stream-name id]
     (let [conn (:conn (redis-conn this))]
       (wcar conn
-            (car/zrangebyscore stream-name
-                               id (inc id) :limit 0 1))))
+            (car/zrangebyscore stream-name id (inc id) :limit 0 1))))
   (db/delete! [this id]
+    (let [conn (:conn (redis-conn this))
+          keys (wcar conn (car/keys "*"))]
+      (wcar conn
+            (dorun (map #(car/zremrangebyscore % id id) keys)))))
+  (db/delete-all! [this]
+    (let [conn (:conn (redis-conn this))]
+      (wcar conn (car/flushall))))
+  (db/put [this data]
     (let [conn (:conn (redis-conn this))]
       (wcar conn
-            #_(car/zremrangebyscore stream-name
-                                  id (inc id) :limit 0 1))))
-  (db/delete-all! [this]
-    )
-  (db/put [this data]
-
-    )
+            (car/zadd (:stream-name data) (:order-id data) data))))
   (db/search [this id]
-    )
+    (let [conn (:conn (redis-conn this))
+          keys (wcar conn (car/keys "*"))]
+      (wcar conn
+            (mapcat #(car/zrangebyscore % id id :limit 0 1) keys))))
   (db/store [this payload]
-    )
+    (let [conn (:conn (redis-conn this))]
+      (wcar conn
+            (car/zadd (:stream-name payload)
+                      (:order-id payload) payload))))
   (db/distinct-values [this k]
-    )
+    ;; TODO: Decide what to do about k (it is always :stream-name)
+    (let [conn (:conn (redis-conn this))]
+      (println conn)
+      (wcar conn (car/keys "*"))))
   (db/lazy-events [this stream-name date]
-    )
+    (db/lazy-events-page this stream-name (* 1000 date) 0))
   (db/lazy-events-page [this stream-name date page]
-    ))
+    (let [conn (:conn (redis-conn this))
+          [st-cursor vs] (wcar conn (car/zscan stream-name page))
+          new-cursor (read-string st-cursor)]
+      (if (= 0 new-cursor)
+        []
+        (let [pairs (partition 2 vs)
+              valid-pairs (remove #(< (read-string (second %)) date)
+                                  pairs)]
+          (concat (map first valid-pairs)
+                  (lazy-seq
+                   (db/lazy-events-page this stream-name
+                                        date new-cursor))))))))

-(defn event []
-  {:stream-name "cambio"
-   :payload {:test :ok}
-   :service-id "muon://dummy"
-   :local-id (java.util.UUID/randomUUID)
-   :server-timestamp (System/currentTimeMillis)})
-
-#_(let [port (int (+ 10000 (* 1000 (Math/random))))
-      rs (RedisServer. port)]
-  (.start rs)
-  (let [server1-conn {:pool {} :spec {:host "127.0.0.1" :port port}}
-        res (wcar server1-conn
-                  (dorun (take 100000 (repeatedly #(let [ev (event)]
-                                                    (car/zadd :cambio (:server-timestamp ev) ev))))))]
-    #_(time (let [res (loop [cursor 0 all-vs []]
-                      (let [[st-cursor vs] (wcar server1-conn
-                                                 (car/zscan :cambio cursor))
-                            new-cursor (read-string st-cursor)
-                            new-vs (doall (concat all-vs vs))]
-                        (if (= 0 new-cursor)
-                          new-vs
-                          (recur new-cursor new-vs))))]
-              (.stop rs)
-              (count (filter map? res))))
-    (let [res (wcar server1-conn (car/zrangebyscore :cambio 0 (System/currentTimeMillis) :limit 0 1))]
-      (.stop rs)
-      res)
-    (let [res (wcar server1-conn (car/keys "*mbio"))]
-      (.stop rs)
-      res)))
-


Cleaned up prep-for-uploading-to-client using threading macro; haven't tested

--- src/polismath/utils.clj
+++ src/polismath/utils.clj
@@ -24,24 +24,6 @@
     xss))

-(defn replace-if-underscore [element val]
-  (if (= element '_)
-    val
-    element))
-
-
-(defn replace-underscores [form val]
-  (map #(replace-if-underscore % val) form))
-
-
-(defn convert-forms [val [next-form & other-forms]]
-  (if (nil? next-form)
-    val
-    (let [next-val (gensym)]
-          `(let [~next-val ~(replace-underscores next-form val)]
-      ~(convert-forms next-val other-forms)))))
-
-
 (defmacro endlessly [interval & forms]
   `(doseq [~'x (range)]
      ~@forms
@@ -64,11 +46,8 @@
   (apply (apply partial f (butlast args)) (apply concat (last args))))

-; apply each function to the result of the previous
-(defn snowball [obj fns] (reduce #(%2 %1) obj fns))
-
-
 (defn use-debuggers []
+  "Handy debugging utility for loading in debugging namespaces"
   (require '[alex-and-georges.debug-repl :as dr])
   (require '[clojure.tools.trace :as tr]))

@@ -78,28 +57,27 @@

 (defn prep-for-uploading-to-client [results]
-  (let [base-clusters (get results :base-clusters)]
-    (snowball
-      results
-      [
-        #(dissoc %1 :mat :rating-mat :opts') ;remove things we don't want to publish
+  (let [base-clusters (:base-clusters results)
+        repness (:base-clusters results)]
+    (-> results
+      ; remove things we don't want to publish
+      (dissoc :mat :rating-mat :opts')

-        ; REFORMAT PROJECTION
-        ; remove original projection - we'll provide buckets/base-clusters instead
-        #(dissoc %1 :proj)
+      ; REFORMAT PROJECTION
+      ; remove original projection - we'll provide buckets/base-clusters instead
+      (dissoc :proj)

-        ; REFORMAT BASE CLUSTERS
-        #(dissoc %1 :base-clusters)
-        #(dissoc %1 :bid-to-pid)
-        #(assoc-in %1 [:base-clusters "x"] (map (fn [x] (first (:center x))) base-clusters))
-        #(assoc-in %1 [:base-clusters "y"] (map (fn [x] (second (:center x))) base-clusters))
-        #(assoc-in %1 [:base-clusters "id"] (map :id base-clusters))
-        #(assoc-in %1 [:base-clusters "members"] (map :members base-clusters))
-        #(assoc-in %1 [:base-clusters "count"] (map (fn [c] (count (:members c))) base-clusters))
+      ; REFORMAT BASE CLUSTERS
+      (dissoc :base-clusters)
+      (dissoc :bid-to-pid)
+      (assoc-in [:base-clusters "x"] (map (fn [x] (first (:center x))) base-clusters))
+      (assoc-in [:base-clusters "y"] (map (fn [x] (second (:center x))) base-clusters))
+      (assoc-in [:base-clusters "id"] (map :id base-clusters))
+      (assoc-in [:base-clusters "members"] (map :members base-clusters))
+      (assoc-in [:base-clusters "count"] (map (fn [c] (count (:members c))) base-clusters))

-        ; REFORMAT REPNESS
-        ; make the array position of each cluster imply the cluster id
-        #(assoc %1 :repness (map :repness (sort-by :id (:repness %1))))
-        ])))
+      ; REFORMAT REPNESS
+      ; make the array position of each cluster imply the cluster id
+      (assoc :repness (map :repness (sort-by :id repness))))))


sorted Hospital associated charity list alphabetically in faq/3/2


pascal trianle refacto

pascal trianle refacto

--- src/sandbox/fractal.clj
+++ src/sandbox/fractal.clj
@@ -8,25 +8,11 @@
   (vec (map #(apply yield %) (partition 2 1 (concat [0] pascal-row [0])))))

 (defn pascal-rows [yield row-number]
-  (loop [nb 0
-         result []
-         latest-result [1]]
-;;=> We'll loop using pascal-row-step,
-;;=> keeping track of the last
-;;computed line at each step of the recursion.
-    (if (<= nb row-number)
-;;=> the counter did not still reach the end
-      (recur (inc nb)
-             (conj result latest-result)
-             (pascal-row-step yield latest-result))
-;;=> We recur incrementing the counter, feeding the new line to
-;; result and keeping track of the last computed line.
-      result)))
-;;=> end of the recursion, emitting result.
+  (take row-number (iterate (partial pascal-row-step yield) [1])))

 (defn even-odd-yield
   [n1 n2]
-  (mod (+ n1 n2) 2))
+  (+ n1 n2))

 (def gr-triangles (partial pascal-rows even-odd-yield))


Added type invariants

Added type invariants

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -273,3 +273,27 @@

   (str (new-Foo :a 77))
 )
+
+(defmacro defconstrainedtype
+  [name slots invariants & etc]
+  (let [fields       (->> slots (partition 2) (map first) vec)
+        defaults     (->> slots (partition 2) (map second))
+        ctor-name    (symbol (str name \.))
+        factory-name (symbol (str "new-" name))]
+    `(do
+       (deftype ~name
+         ~fields
+         ~@etc)
+       (let [chk# (contract ~(symbol (str "chk-" name))
+                            (str "Invariant contract for " (str ~name))
+                            [{:keys ~fields :as m#}] ~invariants)]
+         (defconstrainedfn ~factory-name
+           ([] [] (~ctor-name ~@defaults))
+           (~fields ~invariants
+              (~ctor-name ~@defaults))))
+       ~name)))
+
+(comment
+  (defconstrainedtype Bar [a 4] [pos?])
+  (.a (new-Bar -42))
+)


Basic tasks data and print out

Basic tasks data and print out

--- src/hello_world/core.clj
+++ src/hello_world/core.clj
@@ -28,7 +28,24 @@
         )
   )

-(def response {:html (template "" (html ["h1" "Tasks"]))})
+(defn task-template [tasks]
+  (for [task tasks]
+    (html
+     [:div
+      [:h3 (task :task)]
+      [:p "Done? " (task :done?)]
+     ]
+     )
+    )
+  )
+
+(def index (template "" (html
+                         [:h1 "TODO!"]
+                         [:p "All tasks:"]
+                         (task-template todos)
+                         )))
+
+(def response {:html index })

 (defroutes app-routes
   (GET "/" [] (response :html))


fixing optional run options and classes

fixing optional run options and classes

--- src/celestial/puppet_standalone.clj
+++ src/celestial/puppet_standalone.clj
@@ -79,17 +79,20 @@
     (let [roles {:roles {:web #{remote}}}
           res (execute puppet-provision m :web :env roles)]
         (when-let [fail (-> res first :fail)]
-          (throw fail))
-      )))
+          (throw fail)))))

+(defn into-module
+  "We can pass classes and agent run options"
+  [module machine run-opts]
+  (let [opts (or run-opts {:args [] :classes {}})]
+    (-> module
+      (update-in [:args] (fn [a] (concat a (opts :args))))
+      (merge (select-keys opts [:classes]))
+      (assoc :hostname (machine :hostname)))))

 (defmethod pconstruct :puppet-std
-  [{:keys [run-opts] :as type :or {run-opts {}}} {:keys [machine env] :as spec}]
-  (let [remote {:host (machine :ip) :user (or (machine :user) "root")}]
-    (if-let [m (get-in type [:puppet-std env])]
-      (Standalone. remote
-        (-> m
-          (update-in [:args] (fn [a] (concat a (run-opts :args))))
-          (merge (select-keys run-opts [:classes]))
-          (assoc :hostname (machine :hostname))))
+  [{:keys [run-opts] :as type :or {run-opts {:args []}}} {:keys [machine env] :as spec}]
+  (let [remote {:host (machine :ip) :user (or (machine :user) "root")} ]
+    (if-let [module (get-in type [:puppet-std env])]
+      (Standalone. remote (into-module module machine run-opts) )
         (throw+ {:type ::missing-env} (<< "Type ~(type :type) is missing environment ~{env} values")))))


broadcast swarm scoped messages only once to FE

--- src/clj/swarmpit/handler_events.clj
+++ src/clj/swarmpit/handler_events.clj
@@ -1,6 +1,7 @@
 (ns swarmpit.handler-events
-  (:require [org.httpkit.server :refer [run-server with-channel on-close send! close]]
+  (:require [org.httpkit.server :refer [with-channel on-close send!]]
             [clojure.walk :refer [keywordize-keys]]
+            [clojure.core.memoize :as memo]
             [cheshire.core :refer [generate-string]]
             [immutant.scheduling :refer :all]
             [swarmpit.slt :as slt]
@@ -9,9 +10,16 @@
 (def channel-hub (atom {}))

 (defn broadcast [data]
+  "Broadcast message to all channels and return message hash."
   (let [message (str "data: " (generate-string data) "\n\n")]
     (doseq [channel (keys @channel-hub)]
-      (send! channel message false))))
+      (send! channel message false))
+    (hash data)))
+
+;; Swarm scoped events are received from each manager, but
+;; we want broadcast to FE only once to prevent duplicity.
+;; Therefore we cache event message hash for 1 second.
+(def broadcast-memo (memo/ttl broadcast :ttl/threshold 1000))

 (defmethod dispatch :events [_]
   (fn [{:keys [query-params] :as request}]
@@ -32,6 +40,6 @@
   (fn [{:keys [params]}]
     (if (some? params)
       (do
-        (broadcast params)
+        (broadcast-memo params)
         (resp-accepted (str "Broadcasted to " (count @channel-hub) " clients")))
-      (resp-error 400 "No data send"))))+      (resp-error 400 "No data sent"))))


Function to read job results from artifact

--- src/clj_jenkins_api/jenkins_api.clj
+++ src/clj_jenkins_api/jenkins_api.clj
@@ -13,6 +13,7 @@
 (ns clj-jenkins-api.jenkins-api
     "Module with functions implementing Jenkins API.")

+(require '[clojure.data.json :as json])
 (require '[clj-http.client   :as http-client])

 (defn job-name->url
@@ -60,6 +61,17 @@
             (if data
                 (get data "jobs")
                 nil))))
+
+(defn read-job-results
+    "Read content of given filename from the job artifact."
+    [jenkins-url job-name filename]
+    (let [url (str (job-name->url jenkins-url job-name) "/lastSuccessfulBuild/artifact/" filename)]
+        (println "Using the following URL to retrieve job results: " url)
+        (try
+            (slurp url)
+            (catch Exception e
+                 (.printStackTrace e)
+                 nil))))

 (defn ok-response-structure
     "Structure returned to the calling function when the Jenkins API fails."


Add onchange handler for simple view input

--- src/cljs/cglossa/search_inputs.cljs
+++ src/cljs/cglossa/search_inputs.cljs
@@ -2,13 +2,17 @@
   (:require [clojure.string :as str]))

 (defn cwb-search-inputs [{:keys [search-query]}]
-  (let [displayed-query (-> @search-query
-                            :query
-                            (str/replace #"\[\(?\w+=\"(.+?)\"(?:\s+%c)?\)?\]" "$1"))]
+  (let [query (:query @search-query)
+        displayed-query (str/replace query #"\[\(?\w+=\"(.+?)\"(?:\s+%c)?\)?\]" "$1")
+        phonetic? (not= -1 (.indexOf query "phon="))]
     [:div.row-fluid
-    [:form.form-inline.span12
-     [:div.span10
-      [:input.span12 {:ref "searchfield" :type "text" :value displayed-query}]]]]))
+     [:form.form-inline.span12
+      [:div.span10
+       [:input.span12 {:type "text" :value displayed-query
+                       :on-change #(swap! search-query assoc-in [:query] (aget % "target" "value"))}]
+       [:label {:style {:marginTop 5}}]
+       [:input {:name "phonetic" :type "checkbox"
+                :style {:marginTop -3} :checked phonetic?} " Phonetic form"]]]]))

 (def components {:cwb        cwb-search-inputs
                  :cwb-speech (fn [] [:div "CWB-SPEECHE"])})


Updated saucer collisions

Updated saucer collisions

--- src/cljs/clojuroids/collisions.cljs
+++ src/cljs/clojuroids/collisions.cljs
@@ -25,6 +25,19 @@
               hits (concat hits hit)]
           (recur hits (rest objs)))))))

+(defn collisions1 [state key1 key2]
+  (let [objs (get-in state [:objects key1])
+        objs2 (get-in state [:objects key2])]
+    (loop [hits [] objs objs]
+      (if (not (seq objs))
+        [(sequence (take-nth 2) hits)
+         (sequence (take-nth 2) (rest hits))]
+        (let [hit (some (fn [obj2] (pt-in-rect (first objs) obj2)) objs2)
+              hits (concat hits hit)]
+          (recur hits (rest objs)))))))
+
+;; shot collisions
+;;
 (defn remove-shots [state shots-hit]
   (let [shots (get-in state [:objects :shots])
         shots (sequence (remove #(= % (first shots-hit))) shots)]
@@ -45,6 +58,8 @@
         (flames/create-flames shots-hit)
         (explode/create-explosion roids-hit))))

+;; ship collisions
+;;
 (defn ship-hit [state ship-hits]
   (if (seq ship-hits)
     (assoc-in state [:objects :ship] nil)
@@ -57,5 +72,31 @@
         (explode/create-explosion ship-hits 20)
         (ship-hit ship-hits))))

+;; saucer collisions
+;;
+(defn saucer-hit [state saucer-hits]
+  (if (seq saucer-hits)
+    (assoc-in state [:objects :saucer] nil)
+    state))
+
+(defn saucer-roid [state]
+  (let [[saucer-hits roids-hit] (collisions1 state :saucer :roids)]
+    (-> state
+        (flames/create-flames saucer-hits)
+        (explode/create-explosion saucer-hits 20)
+        (saucer-hit saucer-hits))))
+
+(defn saucer-shots [state]
+  (let [[shots-hits saucer-hits] (collisions1 state :shots :saucer)]
+    (-> state
+        (flames/create-flames saucer-hits)
+        (explode/create-explosion saucer-hits 20)
+        (saucer-hit saucer-hits))))
+
+(defn saucer [state]
+  (-> state (saucer-roid) (saucer-shots)))
+
+;; collisions
+;;
 (defn collisions [state]
-  (-> state (shot-roid) (ship-roid)))
+  (-> state (shot-roid) (ship-roid) (saucer)))


Add genome_if_autoconstructing instruction

--- src/clojush/instructions/genome.clj
+++ src/clojush/instructions/genome.clj
@@ -659,3 +659,16 @@
   (fn [state]
     (push-item (if (:autoconstructing state) true false) :boolean state)))

+(define-registered
+  genome_if_autoconstructing
+  ^{:stack-types [:genome :exec]
+    :parentheses 2}
+  (fn [state]
+    (if (not (empty? (rest (:exec state))))
+      (push-item (if (:autoconstructing state)
+                   (first (:exec state))
+                   (first (rest (:exec state))))
+                 :exec
+                 (pop-item :boolean (pop-item :exec (pop-item :exec state))))
+      state)))
+


adding puppet use cases

adding puppet use cases

--- test/celestial/features/kvm.clj
+++ test/celestial/features/kvm.clj
@@ -33,4 +33,10 @@
            (wf/stop (spec)) => nil
            (wf/start (spec)) => nil
            (wf/destroy (spec)) => nil
-          ))))
+          )
+
+      (fact "kvm puppetization" :integration :kvm :workflow :puppet
+        (wf/create (spec)) => nil
+        (wf/provision redis-type (spec)) => nil
+        (wf/destroy (spec)) => nil)
+      )))


CMR-810: Removed debug output

CMR-810: Removed debug output

--- src/cmr/search/results_handlers/atom_json_results_handler.clj
+++ src/cmr/search/results_handlers/atom_json_results_handler.clj
@@ -50,8 +50,6 @@
                 atom-links associated-difs online-access-flag browse-flag coordinate-system shapes
                 orbit-parameters]} reference
         shape-result (atom-spatial/shapes->json shapes)
-        _ (println "ORBIT PARAMETERS........")
-        _ (println orbit-parameters)
         result (merge {:id id
                        :score score
                        :title title