fix idiot bug where player was flung to the right whenever they let go of a movement key

--- src/voke/system/movement.cljs
+++ src/voke/system/movement.cljs
@@ -45,8 +45,6 @@
     (get-in entity [:brain :intended-move-direction])
     (not-empty (human-controlled-entity-movement-directions entity))))

-(def should-update-velocity? should-update-orientation?)
-
 (sm/defn update-orientation :- Entity
   [entity :- Entity]
   ; TODO - currently only implemented for player-controlled entities, doesn't handle monsters
@@ -59,26 +57,39 @@
                             (apply + (map Math/cos intended-direction-values)))))
     entity))

+(sm/defn should-update-velocity? :- s/Bool
+  [entity :- Entity]
+  (or (should-update-orientation? entity)
+      (and
+        (safe-get-in entity [:motion :affected-by-friction])
+        (or
+          (not= (safe-get-in entity [:motion :velocity :x]) 0)
+          (not= (safe-get-in entity [:motion :velocity :y]) 0)))))
+
 (sm/defn update-velocity :- Entity
   [entity :- Entity]
   ; TODO - currently only implemented for player-controlled entities, doesn't handle monsters
-  (if-let [acceleration (when (should-update-velocity? entity)
-                          (safe-get-in entity [:motion :max-acceleration]))]
-    (let [orientation (safe-get-in entity [:shape :orientation])
-          update-axis-velocity (fn [trig-fn axis-velocity]
+  (if-not (should-update-velocity? entity)
+    entity
+    (let [acceleration (if (not-empty (human-controlled-entity-movement-directions entity))
+                         (safe-get-in entity [:motion :max-acceleration])
+                         0)
+          orientation (safe-get-in entity [:shape :orientation])
+          update-axis-velocity (fn [axis-velocity trig-fn]
+                                 ; TODO - is min the right thing to use here?
+                                 ; what about velocities in negative directions?
+                                 (js/console.log axis-velocity)
                                  (let [new-velocity (min (safe-get-in entity [:motion :max-speed])
                                                          (+ axis-velocity
                                                             (* acceleration
                                                                (trig-fn orientation))))]
+                                   (js/console.log new-velocity)
                                    (if (> (Math/abs new-velocity) min-velocity)
                                      new-velocity
                                      0)))]
       (-> entity
-          (update-in [:motion :velocity :x]
-                     (partial update-axis-velocity Math/cos))
-          (update-in [:motion :velocity :y]
-                     (partial update-axis-velocity Math/sin))))
-    entity))
+          (update-in [:motion :velocity :x] update-axis-velocity Math/cos)
+          (update-in [:motion :velocity :y] update-axis-velocity Math/sin)))))

 (sm/defn apply-friction :- Entity
   [entity :- Entity]
@@ -103,7 +114,7 @@
 (sm/defn relevant-to-movement-system? :- s/Bool
   [entity :- Entity]
   (or
-    (seq (get-in entity [:brain :intended-move-direction] nil))
+    (seq (get-in entity [:brain :intended-move-direction]))
     (not= (get-in entity [:motion :velocity :x] 0) 0)
     (not= (get-in entity [:motion :velocity :y] 0) 0)))


Account for `:onyx.peer/storage.s3.endpoint` in

the model display datastruct.

--- src/onyx/information_model.cljc
+++ src/onyx/information_model.cljc
@@ -1970,15 +1970,16 @@
     :onyx.peer/storage.s3.auth.secret-key
     :onyx.peer/storage.s3.bucket
     :onyx.peer/storage.s3.region
+    :onyx.peer/storage.s3.endpoint
     :onyx.peer/storage.s3.accelerate?
     :onyx.peer/storage.s3.encryption
     :onyx.peer/storage.s3.multipart-copy-part-size
     :onyx.peer/storage.s3.multipart-copy-threshold
-    :onyx.peer/retry-start-interval
+    :onyx.peer/retry-start-interval
     :onyx.peer/join-failure-back-off
-    :onyx.peer/drained-back-off
+    :onyx.peer/drained-back-off
     :onyx.peer/peer-not-ready-back-off
-    :onyx.peer/job-not-ready-back-off
+    :onyx.peer/job-not-ready-back-off
     :onyx.peer/fn-params
     :onyx.peer/backpressure-check-interval
     :onyx.peer/backpressure-low-water-pct


add prn

add prn

--- clj-tcp/src/clj_tcp/client.clj
+++ clj-tcp/src/clj_tcp/client.clj
@@ -236,7 +236,7 @@
                :channel-options channel-options
                :reconnect-count (AtomicInteger.) :closed (AtomicBoolean. false)}
          client (start-client host port conf) ]
-
+    (prn "Creating client with max concurrent writes " max-concurrent-writes)
     (if (not client)
       (do
         (let [cause (read-error {:internal-error-ch internal-error-ch} 200)]


update password field

update password field

--- src/wombats/handlers/game.clj
+++ src/wombats/handlers/game.clj
@@ -275,7 +275,8 @@
              game (get-game-by-id game-id)]

          (when-not (password-match? game join-params)
-           (wombat-error {:code 000005}))
+           (wombat-error {:code 000005
+                          :field-error :password}))

          (when-not game
            (wombat-error {:code 000003


Fix formatting on pagerduty.

Fix formatting on pagerduty.

--- src/riemann/pagerduty.clj
+++ src/riemann/pagerduty.clj
@@ -33,7 +33,8 @@
 (defn pagerduty
   "Creates a pagerduty adapter. Takes your PD service key, and returns a map of
   functions which trigger, acknowledge, and resolve events. Event service will
-  be used as the incident key. The PD description will be the service, state, and metric. The full event will be attached as the details.
+  be used as the incident key. The PD description will be the service, state,
+  and metric. The full event will be attached as the details.

   (let [pd (pagerduty \"my-service-key\")]
     (changed-state


change formatting

change formatting

--- word-count-cascalog.clj
+++ word-count-cascalog.clj
@@ -14,4 +14,5 @@
        [?word ?count]
        ((hfs-delimited in :skip-header? true) _ ?line)
        (split ?line :> ?word)
-       (c/count ?count)))+       (c/count ?count))
+)


trying out minifying lexicons; looks promising

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -599,6 +599,9 @@
                                   (or (and
                                        (= (get-in % [:synsem :cat]) :verb)

+                                       (or true (= (get-in % [:italiano :italiano]) "sedersi")
+                                           (= (get-in % [:synsem :aux]) true))
+
                                        (or (= (get-in % [:synsem :sem :obj] :unspec) :unspec) ;; exclude transitive verbs..
                                            (= (get-in % [:synsem :sem :reflexive] false) true))  ;; ..but allow reflexive verbs.


add canary debugging component

add canary debugging component

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -2168,6 +2168,14 @@
                               phonize
                               ;; TODO: rewrite italian-specific-rules as (constrain-vals-if)(one or more)
                               italian-specific-rules)
+
+
+                 (constrain-vals-if
+                  (fn [val]
+                    :top)
+                  (fn [val]
+                    (unify val {:synsem {:sem {:blah 99}}})))
+
                  (constrain-vals-if
                   (fn [val]
                     (if (get universals (get-in val [:synsem :sem :pred]))


Fix Sneakdoor interaction with Security Testing and Ash trace. Fixes #1138.

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -590,6 +590,9 @@
                                    {:req (req (= target :archives))
                                     :successful-run
                                     {:effect (req (swap! state assoc-in [:run :server] [:hq])
+                                                  ; remove the :req from the run-effect, so that other cards that replace
+                                                  ; access don't use Sneakdoor's req. (Security Testing, Ash 2X).
+                                                  (swap! state dissoc-in [:run :run-effect :req])
                                                   (trigger-event state :corp :no-action)
                                                   (update-run-ice state side)
                                                   (system-msg state side


Fix ugly linebreaks

Fix ugly linebreaks

--- src/cljs/binary_clock/core.cljs
+++ src/cljs/binary_clock/core.cljs
@@ -9,42 +9,38 @@
   (atom
    {:time (js/Date.)}))

+
 (defn decimal-parts [n]
   [(quot n 10) (mod n 10)])
+
 (defn bit-match [n]
   (mapv #(bit-test n %) [3 2 1 0]))

-(defn time->parts
-  [time]
+(defn time->parts [time]
   [(.getHours time) (.getMinutes time) (.getSeconds time)])

-(defcomponent binary-cell
-  [active _]
+
+(defcomponent binary-cell [active _]
   (render
    [_]
    (dom/div {:class (str "cell"
                          (if active " active" ""))})))

-(defcomponent binary-column
-  [column owner]
-
+(defcomponent binary-column [column owner]
   (render
    [_]
    (dom/div {:class "column"}
             (om/build-all binary-cell (bit-match column))
             (dom/div {:class "num"} column))))

-(defcomponent binary-part
-  [part owner]
-
+(defcomponent binary-part [part owner]
   (render
    [_]
    (dom/div {:class "part"}
             (om/build-all binary-column (decimal-parts part)))))

-(defcomponent main-view
-  [app owner]

+(defcomponent main-view [app owner]
   (will-mount
    [_]
    (js/setInterval #(om/update! app :time (js/Date.)) 1))


Minor formating

Minor formating

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -86,12 +86,12 @@
   (let [on-remove #(update-card! (api/remove-task-at card %))
         on-check #(update-card! (update-in card [:tasks % :done] not))]
     [:div.checklist
-    [:ul
-     (map
-       (fn [idx t]
-         ^{:key t} [render-task #(on-remove idx) #(on-check idx) t])
-       (range) tasks)
-     ]]))
+     [:ul
+      (map
+        (fn [idx t]
+          ^{:key t} [render-task #(on-remove idx) #(on-check idx) t])
+        (range) tasks)]
+     ]))

 (defn render-add-task
   "Render the text field allowing to add new tasks to a card"
@@ -104,8 +104,8 @@
       (when (= "Enter" (.-key e))
         (update-card! (api/add-task card (.. e -target -value)))
         (set! (.. e -target -value) "")
-        ))
-    }])
+      ))
+   }])

 (defn render-card
   []


Comments

Comments

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -149,13 +149,15 @@

 (defn render-toggle-all
   [card-refs]
-  ; !!! The handler works, but no refresh occurs
+  ; TODO - Does not work so good: you need the state of other cards
+  ; Because they might not be in the same state => the label must change
   (let [toggle #(update-in % [::show-details] not)
         on-click (fn []
                    (doall
                      (map #(swap! % update-in [::show-details] not) card-refs))
                  )
-        ;on-click2 (fn [] (swap! card-refs #(map toggle %)))
+        ; !!! The following handler works when given @cards but no refresh occurs
+        ; on-click2 (fn [] (swap! card-refs #(map toggle %)))
         ]
     [:button.header-button
      {:on-click on-click :type "button"} "Expand all"]


better tool paths

better tool paths

--- src/clojure/staircase/tools.clj
+++ src/clojure/staircase/tools.clj
@@ -1,5 +1,6 @@
 (ns staircase.tools
-  (:use [clojure.string :only (replace-first)])
+  (:use [clojure.string :only (replace-first)]
+        [clojure.tools.logging :only (info debug)])
   (:require [cheshire.core :as json]
             [clojure.java.io :as io]))

@@ -13,7 +14,7 @@
   (with-open [r (-> (str "tools/" (name tool-name) "/tool.json")
                     io/resource
                     io/reader)]
-    (let [prefix #(replace-first % "." (name tool-name))]
+    (let [prefix #(replace-first % "." (str "/" (name tool-name)))]
       (-> (slurp r)
           (json/parse-string true)
           (#(merge tool-defaults %))
@@ -33,6 +34,7 @@

 (defn get-tools
   [config capability]
+  (debug "Getting tools with the" capability "capability")
   (let [tools (config :tools)]
     (->> tools
          (map get-tool-conf)


Fix bug in data point processing

Fix bug in data point processing

--- src-cljs/frontend/components/insights/project.cljs
+++ src-cljs/frontend/components/insights/project.cljs
@@ -52,42 +52,39 @@
       (html
        [:div.build-time-visualization]))))

-(defn median-build-time [[build-date builds]]
-  [(time-format/parse build-date) (->> builds
-                                       (map :build_time_millis)
-                                       insights/median)])

-(defn daily-median-build-time [builds]
-    (js/console.log (clj->js (->> builds
-       (group-by #(-> % :start_time time-format/parse time/at-midnight str))
-       )))
+(defn daily-median-build-time
+  "Given a collection of builds, returns a list of vector pairs
+  [build-date median-build-time], where build-date is midnight of each day where
+  a build started (UTC), and median-build-time is the median of the build times
+  of all builds from that day. The list is sorted by build-date, ascending."
+  [builds]
   (->> builds
-       (group-by #(-> % :start_time time-format/parse time/at-midnight str))
-       (map median-build-time)))
+       (group-by #(-> % :start_time time-format/parse time/at-midnight))
+       (into (sorted-map))
+       (map (fn [[build-date bs]]
+              [build-date (->> bs
+                               (map :build_time_millis)
+                               insights/median)]))))
+

 (defn build-time-line-chart [builds owner]
   (reify
     om/IDidMount
     (did-mount [_]
-     (let [el (om/get-node owner)
-           build-times (daily-median-build-time builds)]
-       #_(->> build-times
-            (map first)
-            (map str)
-            sort
-            clj->js
-            js/console.log)
-       (js/c3.generate (clj->js {:bindto el
-                                 :padding {:top 10}
-                                 :data {:x "date"
-                                        :type "spline"
-                                        :columns [(concat ["date"] (map first build-times))
-                                                  (concat ["Median Build Time"] (map last build-times))]}
-                                   :legend {:hide true}
-                                    :grid {:y {:show true}}
-                                    :zoom {:enabled true}
-                                    :axis {:x {:type "timeseries"
-                                               :tick {:format "%m/%d"}}}}))))
+      (let [el (om/get-node owner)
+            build-times (daily-median-build-time builds)]
+        (js/c3.generate (clj->js {:bindto el
+                                  :padding {:top 10}
+                                  :data {:x "date"
+                                         :type "spline"
+                                         :columns [(concat ["date"] (map first build-times))
+                                                   (concat ["Median Build Time"] (map last build-times))]}
+                                  :legend {:hide true}
+                                  :grid {:y {:show true}}
+                                  :zoom {:enabled true}
+                                  :axis {:x {:type "timeseries"
+                                             :tick {:format "%m/%d"}}}}))))
     om/IRender
     (render [_]
       (html


Hook up new parallelism button

Hook up new parallelism button

(Breaks the button's style for now.)

--- src-cljs/frontend/components/insights/project.cljs
+++ src-cljs/frontend/components/insights/project.cljs
@@ -3,6 +3,7 @@
             [frontend.components.insights :as insights]
             [frontend.datetime :as datetime]
             [frontend.models.project :as project-model]
+            [frontend.routes :as routes]
             [frontend.state :as state]
             [om.core :as om :include-macros true])
   (:require-macros [frontend.utils :refer [html defrender]]))
@@ -92,7 +93,9 @@
           [:dl
            [:dt "parallelism"]
            [:dd parallel
-            [:button.btn.btn-xs.btn-default
+            [:a.btn.btn-xs.btn-default {:href (routes/v1-project-settings-subpage {:org (:username project)
+                                                                                :repo (:reponame project)
+                                                                                :subpage "parallel-builds"})}
              [:i.material-icons "tune"]]]]]]
         [:div.card
          (om/build project-insights-bar chartable-builds)]]))))


Shrink char, string and keyword

Shrink char, string and keyword

--- src/simple_check/generators.clj
+++ src/simple_check/generators.clj
@@ -11,6 +11,8 @@
   (shrink [this]))

 (defn fmap
+  "NOTE: since `gen` is a function, this is just equivalent
+  to `comp`. Perhaps using fmap will be more confusing to people?"
   [f gen]
   (fn [rand-seed size]
     (f (gen rand-seed size))))
@@ -134,6 +136,31 @@
                                       (choose 65 90)
                                       (choose 97 122)])))

+(defn- stamp
+  [c]
+  [(not (Character/isLowerCase c))
+   (not (Character/isUpperCase c))
+   (not (Character/isDigit c))
+   (not= \space c)
+   c])
+
+(defn- <-stamp
+  [a b]
+  (neg? (compare (stamp a) (stamp b))))
+
+(defn shrink-char
+  [c]
+  (filter #(<-stamp % c)
+          (concat [\a \b \c]
+                  (for [x [c] :while #(Character/isUpperCase %)]
+                    (Character/toLowerCase x))
+                  [\A \B \C
+                   \1 \2 \3
+                   ;; TODO: should newline be here? It will make ascii chars
+                   ;; shrink incorrectly. But it's also useful for finding bugs...
+                   ;; \newline
+                   \space])))
+
 (defn string
   [rand-seed size]
   (apply str (repeatedly size #(char rand-seed size))))
@@ -146,6 +173,10 @@
   [rand-seed size]
   (apply str (repeatedly size #(char-alpha-numeric rand-seed size))))

+(defn shrink-string
+  [s]
+  (clojure.core/map (partial apply str) (shrink-seq s)))
+
 (def keyword (fmap clojure.core/keyword string-alpha-numeric))

 (defn shrink-map
@@ -176,3 +207,19 @@
 (extend clojure.lang.IPersistentMap
   Shrink
   {:shrink shrink-map})
+
+(extend java.lang.Character
+  Shrink
+  {:shrink shrink-char})
+
+(extend java.lang.String
+  Shrink
+  {:shrink shrink-string})
+
+(extend clojure.lang.Keyword
+  Shrink
+  {:shrink (comp
+             (partial clojure.core/map clojure.core/keyword)
+             shrink-string
+             #(apply str (rest %))
+             str)})


Improve the copy when removing SSH keys

Improve the copy when removing SSH keys

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -1026,9 +1026,16 @@
                                                (om/build remove-action-button
                                                          {:confirmation-question
                                                           (str
-                                                           "Are you sure you want to remove the \""
-                                                           (:hostname ssh-key)
-                                                           "\" SSH key?")
+                                                           "Are you sure you want to remove the SSH key \""
+                                                           (:fingerprint ssh-key)
+                                                           "\""
+                                                           (if (:hostname ssh-key)
+                                                             (str
+                                                              " for the hostname \""
+                                                              (:hostname ssh-key)
+                                                              "\"")
+                                                             " for all hosts")
+                                                           "?")

                                                           :remove-fn
                                                           #(raise! owner [:deleted-ssh-key


Prettier add/edit connection dialog

Prettier add/edit connection dialog

--- src/sqls/ui/edit_connection.clj
+++ src/sqls/ui/edit_connection.clj
@@ -16,7 +16,8 @@
                             to-root
                             value
                             vertical-panel
-                            ]]))
+                            ]])
+  (:require seesaw.mig))

 (defn on-btn-save-connection-cancel
@@ -83,6 +84,7 @@
       (show-test-success! (to-root e))
       (show-test-failure! (to-root e) (:desc result)))))

+
 (defn create-edit-connection-frame
   "Create add-or-edit connection dialog.

@@ -99,35 +101,38 @@
         conn-str (get conn-data "jdbc-conn-str")
         conn-desc (get conn-data "desc")
         label-texts ["Name"
-                "Driver JAR file (optional)"
-                "Driver Class"
-                "JDBC Connection String"
-                "Description (optional)"]
+                     "Driver JAR file (optional)"
+                     "Driver Class"
+                     "JDBC Connection String"
+                     "Description (optional)"]
         labels (map #(label :text % :border 2 :preferred-size [100 :by 0]) label-texts)
         default-field-options {:preferred-size [0 :by 400]}
-        fields [
-                (text :id :name :text conn-name :preferred-size [400 :by 0])
+        fields [(text :id :name :text conn-name :preferred-size [400 :by 0])
                 (text :id :jar :text conn-jar)
                 (text :id :class :text conn-class)
                 (text :id :jdbc-conn-str :text conn-str)
-                (text :id :desc :text conn-desc)
-                ]
-        buttons [
-                 (button :id :cancel :text "Cancel" :listen [:action on-btn-save-connection-cancel])
+                (text :id :desc :text conn-desc)]
+        buttons [(button :id :cancel :text "Cancel" :listen [:action on-btn-save-connection-cancel])
                  (button :id :test :text "Test" :listen [:action (partial on-btn-test-connection test-conn!)])
-                 (button :id :ok :text "Ok" :listen [:action (partial on-btn-save-connection-ok conn-list-frame save! conn-data)])
-                 ]
-        form-items (interleave labels fields)]
+                 (button :id :ok :text "Ok" :listen [:action (partial on-btn-save-connection-ok conn-list-frame save! conn-data)])]
+        label-to-mig-panel-item (fn [w] [w])
+        field-to-mig-panel-item (fn [w] [w "grow, wrap"])
+        label-mig-panel-items (map label-to-mig-panel-item labels)
+        field-mig-panel-items (map field-to-mig-panel-item fields)
+        button-mig-panel-items [[(horizontal-panel :items buttons) "span 2, align right"]] ; only one item that contains vertical-panel and spans all columns
+        mig-panel-items (concat (interleave label-mig-panel-items field-mig-panel-items) button-mig-panel-items)
+        mig-panel-constraints ["fillx" "[grow 0][grow]"]]
     (assert (= (count labels) (count fields)))
-    (println "create-edit-connection-frame")
+    ; (println "mig panel items:" mig-panel-items)
     (->
-      (custom-dialog
-          :title "SQLS: Add connection"
-          :content (vertical-panel :border 4
-                                   :items [
-                                           (grid-panel :columns 2
-                                                       :items form-items)
-                                           (horizontal-panel :id :buttons
-                                                             :items buttons)]))
+      (custom-dialog :title "SQLS: Add connection"
+                     :content (seesaw.mig/mig-panel :items mig-panel-items
+                                                    :constraints mig-panel-constraints))
+          ; :content (vertical-panel :border 4
+          ;                          :items [
+          ;                                  (grid-panel :columns 2
+          ;                                              :items form-items)
+          ;                                  (horizontal-panel :id :buttons
+          ;                                                    :items buttons)]))
       pack!)))


allow the logstash public IP in ES

allow the logstash public IP in ES

--- src/terraboot/elasticsearch.clj
+++ src/terraboot/elasticsearch.clj
@@ -98,7 +98,7 @@
      (template-file (vpc-unique "elasticsearch-policy")
                     (elasticsearch-policy)
                     {:es-arn es-arn-*
-                     :allowed-ips  (vpc-output-of "aws_eip" "vpn" "public_ip")})
+                     :allowed-ips  (vpc-output-of "aws_eip" "logstash" "public_ip")})

      (vpc-resource "aws_elasticsearch_domain" (str (vpc-unique name) "-5")
                    {:domain_name (str (vpc-unique name) "-5")


(maint) fix bug in error message

(maint) fix bug in error message

--- src/puppetlabs/trapperkeeper/services_internal.clj
+++ src/puppetlabs/trapperkeeper/services_internal.clj
@@ -57,7 +57,7 @@
     {:fns fns}
     (throw (IllegalArgumentException.
              (format
-               "Invalid service definition; expected function definitions following dependency list, invalid value: '\"hi\"'"
+               "Invalid service definition; expected function definitions following dependency list, invalid value: '%s'"
                (pr-str (first (filter #(not (seq? %)) fns))))))))

 (defn validate-deps-form!


first wide-domain: symbol

first wide-domain: symbol

--- src/such/wide_domains.clj
+++ src/such/wide_domains.clj
@@ -1,2 +1,25 @@
 (ns such.wide-domains
-  "Variants of clojure.core functions that accept more types of inputs.")
+  "Variants of clojure.core functions that accept more types of inputs."
+  (:refer-clojure :exclude [find-var symbol])
+  (:require [such.casts :as cast]))
+
+
+(defn symbol
+  "Creates a symbol.
+  The `ns` argument may be a namespace, symbol, or string ([[as-ns-string]]).
+  The `name` argument may be a symbol, string, keyword, or var.
+
+  In the one-argument version, the resulting symbol has a `nil` namespace.
+  In the two-argument version, it has the symbol version of `ns` as the namespace.
+  Note that `ns` need not refer to an existing namespace.
+
+      (symbol \"th\") => 'th
+      (symbol 'clojure.core \"th\") => 'clojure.core/th
+
+      (symbol *ns* 'th) => 'this.namespace/th ; \"add\" a namespace
+      (symbol *ns* 'clojure.core/even?) => 'this.namespace/even? ; \"localize\" a symbol.
+"
+([name]
+ (clojure.core/symbol (cast/as-name-string name)))
+([ns name]
+  (clojure.core/symbol (str (cast/as-ns-symbol ns)) (cast/as-name-string name))))


Use allow-all-sg in the asg security groups

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -127,10 +127,7 @@
                               :to_port 65535
                               :protocol "udp"
                               :cidr_blocks (vec (vals (:public vpc/cidr-block)))}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol "udp"
-                              :cidr_blocks (vec (vals (:public vpc/cidr-block)))})
+                             )

              (security-group "lb-security-group" {}
                              {:port 2181
@@ -147,21 +144,12 @@
                               :source_security_group_id (id-of "aws_security_group" "lb-security-group")}
                              {:port 2181
                               :source_security_group_id (id-of "aws_security_group" "lb-security-group")}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "public-slave-security-group")}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "slave-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "public-slave-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "slave-security-group")}
                              )

              (security-group "public-slave-security-group" {}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "master-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "master-security-group")}
                              {:from_port 0
                               :to_port 21
                               :cidr_blocks [all-external]}
@@ -185,28 +173,13 @@
                               :to_port 65535
                               :protocol "udp"
                               :cidr_blocks [all-external]}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "public-slave-security-group")}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "slave-security-group")})
+                             {:allow-all-sg (id-of "aws_security_group" "public-slave-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "slave-security-group")})

              (security-group "slave-security-group" {}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "public-slave-security-group")}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "slave-security-group")}
-                             {:from_port 0
-                              :to_port 65535
-                              :protocol -1
-                              :source_security_group_id (id-of "aws_security_group" "master-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "public-slave-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "slave-security-group")}
+                             {:allow-all-sg (id-of "aws_security_group" "master-security-group")}
                              {:port 2181
                               :source_security_group_id (id-of "aws_security_group" "lb-security-group")})


Added helpful error messages

Added helpful error messages

--- src/clojure/funcatron/tron/modes/tron_mode.clj
+++ src/clojure/funcatron/tron/modes/tron_mode.clj
@@ -212,7 +212,7 @@
         ;; load the file and make sure it's a valid func bundle
         (let [thing (jarjar/build-router file {})]
           (.endLife thing))
-        (let [{:keys [sha type swagger host basePath file-info]} (common/sha-and-swagger-for-file file)]
+        (let [{:keys [sha type swagger host basePath file-info] :as dog} (common/sha-and-swagger-for-file file)]
           (if (and type file-info)
             (let [dest-file (fu/new-file
                               (common/calc-storage-directory opts)
@@ -231,7 +231,11 @@
                         :swagger  swagger
                         :sha      sha}})
             (do
+              (info (str "Failed to upload Func Bundle... failed the type and file-info test. Type "
+                         type " file-info " file-info))
+              (info (str "The most likely reason is a missing or malformed funcatron.yaml file"))
               {:status 400
+
                  :body   {:accepted false
                           :error    "Could not determine the file type"}})))
         (catch Exception e (do


Very little experiments with repl history

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

--- src/conexp/contrib/gui/repl.clj
+++ src/conexp/contrib/gui/repl.clj
@@ -200,7 +200,10 @@
   (let [^JTextArea repl-window (JTextArea. ^javax.swing.text.Document repl-container)]
     (doto repl-window
       (add-input-event "control C" "interrupt")
-      (add-action-event "interrupt" #(repl-interrupt repl-thread)))))
+      (add-action-event "interrupt" #(repl-interrupt repl-thread))
+      (add-input-event "meta p" "previous")
+      (add-input-event "meta n" "next")
+      (add-action-event "next" #(println "next entry")))))

 ;;;


Remove debugging println from add-menus

Remove debugging println from add-menus

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

--- src/conexp/contrib/gui/util.clj
+++ src/conexp/contrib/gui/util.clj
@@ -195,7 +195,6 @@
   "Takes a sequences of menus and adds them to the given frame"
   [frame menus]
   (let [framebar (first (select frame [:JMenuBar]))]
-    (println menus)
     (config! frame :menubar
              (menubar :items (vec (concat (when framebar (config framebar :items))
                                           menus))))))


Another alias

Another alias

«follows?» points to «follows-semantically?»

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -134,6 +134,8 @@
   [implication implications]
   (subset? (conclusion implication)
            (close-under-implications implications (premise implication))))
+
+(defalias follows? follows-semantically?)

 (defn equivalent-implications?
   "Returns true iff the two seqs of implications are equivalent."


Moved copy&paste handlers to named functions table-to-clipboard! and clipboard-to-table!

--- src/conexp/gui/editors/util.clj
+++ src/conexp/gui/editors/util.clj
@@ -391,6 +391,54 @@
 ;;
 ;;
 ;;
+
+(defn-swing-threads* clipboard-to-table!
+  "Takes a table widget as parameter and will paste the current
+   clipboard contents in the cell block marked by the current
+   selected cell.
+
+  Parameters:
+    obj     _a table widget" [obj]
+  (let [control (get-control obj)
+         sel-columns ((*comp (rho .getSelectedColumns) extract-array)
+                       control)
+         sel-rows ((*comp (rho .getSelectedRows) extract-array)
+                    control)]
+    (if (or (empty? sel-columns) (empty? sel-rows)) nil
+      (let [data (str (get-clipboard-contents))
+             startx (first sel-columns)
+             starty (first sel-rows)
+             cells (vec (map (*comp (rho split #"\t") (rho vec))
+                          (split-lines data)))
+             lns (range (count cells))]
+        (one-by-one lns (fn [r]
+                          (one-by-one (range (count (cells r)))
+                            (fn [c]
+                              (.setValueAt control
+                                ((cells r) c)
+                                (+ starty r)
+                                (+ startx c))))))))))
+
+(defn-swing-threads* table-to-clipboard!
+  "Takes a table widget as parameter and copies the current
+   selected cells to the clipboard.
+
+  Parameters:
+    obj      _a table widget" [obj]
+  (let [control (get-control obj)
+         sel-columns ((*comp (rho .getSelectedColumns) extract-array)
+                       control)
+         sel-rows ((*comp (rho .getSelectedRows) extract-array)
+                    control)
+         sel-pairs (map (fn [y] (map (fn [x] (list y x)) sel-columns))
+                     sel-rows)
+         sel-values (map (fn [l] (map (fn [p] (str (.getValueAt control
+                                                     (first p)
+                                                     (second p)))) l))
+                      sel-pairs)
+         sel-lines (map (rho join "\t") sel-values)
+         selection (join "\n" sel-lines)]
+    (set-clipboard-contents selection)))

 (defn-swing do-mk-table-control
   "Creates a table control in Java.
@@ -484,43 +532,10 @@
          defaults [ [:set-resize-mode :off]
                     [:set-cell-selection-mode :cells]
                     [:register-keyboard-action
-                      (fn-swing-threads* [obj]
-                        (let [control (get-control obj)
-                              sel-columns ((*comp (rho .getSelectedColumns) extract-array)
-                                           control)
-                              sel-rows ((*comp (rho .getSelectedRows) extract-array)
-                                           control)
-                              sel-pairs (map (fn [y] (map (fn [x] (list y x)) sel-columns))
-                                             sel-rows)
-                              sel-values (map (fn [l] (map (fn [p] (str (.getValueAt control
-                                                                                (first p)
-                                                                                (second p)))) l))
-                                              sel-pairs)
-                              sel-lines (map (rho join "\t") sel-values)
-                              selection (join "\n" sel-lines)]
-                          (set-clipboard-contents selection)))
+                      table-to-clipboard!
                       "Copy" keystroke-copy :focus]
                     [:register-keyboard-action
-                      (fn-swing-threads* [obj]
-                        (let [control (get-control obj)
-                              sel-columns ((*comp (rho .getSelectedColumns) extract-array)
-                                           control)
-                              sel-rows ((*comp (rho .getSelectedRows) extract-array)
-                                           control)]
-                          (if (or (empty? sel-columns) (empty? sel-rows)) nil
-                              (let [data (str (get-clipboard-contents))
-                                    startx (first sel-columns)
-                                    starty (first sel-rows)
-                                    cells (vec (map (*comp (rho split #"\t") (rho vec))
-                                               (split-lines data)))
-                                    lns (range (count cells))]
-                                (one-by-one lns (fn [r]
-                                                  (one-by-one (range (count (cells r)))
-                                                              (fn [c]
-                                                                (.setValueAt control
-                                                                             ((cells r) c)
-                                                                             (+ starty r)
-                                                                             (+ startx c))))))))))
+                      clipboard-to-table!
                       "Paste" keystroke-paste :focus]
                     ]]
     (do


revised root_concept_identifier_gen rule

Added handling for the case where a class is both a subclass of another
class and an explicit subclass of owl:Thing

Also excluded rdf and skos classes

--- resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_a/root_concept_identifier_gen.clj
+++ resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_a/root_concept_identifier_gen.clj
@@ -9,18 +9,24 @@
                  :ns "ccp" :prefix "" :suffix ""}])
   :sparql-string "prefix oboInOwl: <http://www.geneontology.org/formats/oboInOwl#>
   select ?root {
-  ?root rdf:type owl:Class .
-  # return classes that are subClassOf owl:Thing or classes that are not subClassOf anything
-  filter ((exists {?root rdfs:subClassOf owl:Thing}) || (not exists {?root rdfs:subClassOf ?class}))
-  # exclude all deprecated classes
-  filter (not exists {?root owl:deprecated true})
-  # exclude any blank nodes
-  filter (!contains(str(?root), '/bnode/'))
-  # exclude the oboInOwl:ObsoleteClass class
-  filter (?root != oboInOwl:ObsoleteClass)
-  # exclude ICE world concepts (IAO, CCP extension ontology, OA ontology)
-  filter (!contains (str(?root), 'ext/IAO_'))
-  filter (!contains (str(?root), 'obo/IAO_'))
-  filter (!contains (str(?root), 'http://www.w3.org/ns/oa#'))
-  }"
+                ?root rdf:type owl:Class .
+                # return classes that are subClassOf owl:Thing or classes that are not subClassOf anything
+                filter ((exists {?root rdfs:subClassOf owl:Thing}) || (not exists {?root rdfs:subClassOf ?class}))
+                # but don't return classes that are subClassOf owl:Thing and subClass of some other class
+                filter (not exists {?root rdfs:subClassOf owl:Thing .
+                                    ?root rdfs:subClassOf ?class .
+                                    filter (?class != owl:Thing)})
+                # exclude all deprecated classes
+                filter (not exists {?root owl:deprecated true})
+                # exclude any blank nodes
+                filter (!contains(str(?root), '/bnode/'))
+                # exclude the oboInOwl:ObsoleteClass class
+                filter (?root != oboInOwl:ObsoleteClass)
+                # exclude ICE world concepts (IAO, CCP extension ontology, OA ontology)
+                filter (!contains (str(?root), 'ext/IAO_'))
+                filter (!contains (str(?root), 'obo/IAO_'))
+                filter (!contains (str(?root), 'http://www.w3.org/ns/oa#'))
+                filter (!contains (str(?root), 'http://www.w3.org/2004/02/skos/core#'))
+                filter (!contains (str(?root), 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'))
+}"
 }


Fix handling of false in entity cache

Fix handling of false in entity cache

--- src/datascript/impl/entity.cljc
+++ src/datascript/impl/entity.cljc
@@ -161,14 +161,15 @@
      (.-eid this)
      (if (db/reverse-ref? attr)
        (-lookup-backwards (.-db this) (.-eid this) (db/reverse-ref attr) not-found)
-       (or (@(.-cache this) attr)
-           (if @(.-touched this)
-             not-found
-             (if-let [datoms (not-empty (db/-search (.-db this) [(.-eid this) attr]))]
-               (let [value (entity-attr (.-db this) attr datoms)]
-                 (vreset! (.-cache this) (assoc @(.-cache this) attr value))
-                 value)
-               not-found)))))))
+       (if-let [[_ v] (find @(.-cache this) attr)]
+         v
+         (if @(.-touched this)
+           not-found
+           (if-let [datoms (not-empty (db/-search (.-db this) [(.-eid this) attr]))]
+             (let [value (entity-attr (.-db this) attr datoms)]
+               (vreset! (.-cache this) (assoc @(.-cache this) attr value))
+               value)
+             not-found)))))))

 (defn touch-components [db a->v]
   (reduce-kv (fn [acc a v]


Lambdas to filter jobs per product and (version)

--- src/emender_jenkins/results.clj
+++ src/emender_jenkins/results.clj
@@ -115,10 +115,17 @@
           ;job-results))
 ))

-(defn get-job-names
-    []
+(defn select-jobs
+    [results pred]
     (into []
-        (for [job @results] (:job-name job))))
+        (filter pred results)))
+
+(defn get-job-results
+    [product version]
+    (cond
+        (and product version) (select-jobs @results #(and (= product (:product %)) (= version (:version %))))
+        product               (select-jobs @results #(= product (:product %)))
+        :else                 (into [] @results)))

 (defn find-job-with-name
     [job-name]


Fix typo

Fix typo

--- src/fhofherr/simple/project.clj
+++ src/fhofherr/simple/project.clj
@@ -16,7 +16,7 @@
   Test commands are functions that expect a `job-context` map as their only
   argument.

-  Just a test commands Simple CI jobs themselfes are functions. They too expect
+  Just as test commands Simple CI jobs themselfes are functions. They too expect
   a `job-context` as their only argument which they pass on to their test
   command.


CMR-6537-4 updated json handler

CMR-6537-4 updated json handler

--- search-app/src/cmr/search/results_handlers/subscriptions_json_results_handler.clj
+++ search-app/src/cmr/search/results_handlers/subscriptions_json_results_handler.clj
@@ -37,4 +37,4 @@

 (defmethod qs/search-results->response [:subscription :json]
   [context query results]
-  (json/generate-string (select-keys results [:hits :took :items])))+  (json/generate-string (select-keys results [:hits :took :items])))


tests failing due to lack of equality between byte arrays.

--- test/clj/elephantdb/cascading/integration_test.clj
+++ test/clj/elephantdb/cascading/integration_test.clj
@@ -78,7 +78,6 @@
     (-> (create-source tmp pairs)
         (hfs->elephant elephant-sink))))

-;; TODO: Use custom EDB JobConf here.
 (defn get-tuples
   "Returns all tuples in the supplied cascading tap as a Clojure
   sequence."
@@ -107,15 +106,15 @@
 (defn check-results
   "TODO: Move over to edb proper."
   [dpath pairs]
-  (t/with-single-service-handler [handler {"domain" dpath}]
-    (t/check-domain "domain" handler pairs)))
+  (is (= (set (read-etap-with-flow dpath))
+         (set pairs))))

 ;; TODO: Invalid. Doesn't belong in this project; this makes far too
 ;; many assumptions about a thrift interface, etc. All we're concerned
 ;; about here is getting data in and out of edb w/ cascading.
 (def-fs-test test-basic [fs tmp]
   (let [spec (DomainSpec. (JavaBerkDB.) (HashModScheme.) 4)
-        sink (ElephantDBTap. tmp spec (mk-options nil))
+        sink (ElephantDBTap. tmp spec (mk-options :updater nil))
         data [[0 (barr 0 0)]
               [1 (barr 1 1)]
               [2 (barr 2 2)]


Improve the status sync function

Improve the status sync function

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -2,7 +2,8 @@
   (:require [clj-xpath.core :refer [xml->doc $x:text]]
             [clojure.java.io :refer [file delete-file]]
             [immutant.messaging :as msg]
-            [environ.core :refer [env]])
+            [environ.core :refer [env]]
+            [mdr2.production :as production])
   (:import javax.xml.XMLConstants
            org.xml.sax.SAXException
            javax.xml.validation.SchemaFactory
@@ -48,19 +49,19 @@
 (defn import-file
   "Import new productions from ABACUS and put them on the create queue"
   []
-  (doseq [f (filter #(.isFile %)
+  (doseq [f (filter #(and (.isFile %) (valid? %))
                     (file-seq (file import-dir)))]
-    (when (valid? f)
-      (msg/publish "queue.create" (read-file f))
-      (delete-file f))))
+    (msg/publish "queue.create" (read-file f))
+    (delete-file f))))

 (defn status-sync
   "Import status updates from ABACUS and put them on the archive queue"
   []
-  (doseq [f (filter #(.isFile %)
+  (doseq [f (filter #(and (.isFile %) (valid? %))
                     (file-seq (file import-dir)))]
-    (when (valid? f)
-      (msg/publish "queue.archive" (read-file f))
+    (let [{product-number :productNumber} (read-file f)
+          production (production/find-by-productnumber product-number)]
+      (msg/publish "queue.archive" production)
       (delete-file f))))

 (defn notify


Update the magic numbers in the ABACUS export file

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -210,15 +210,13 @@
   [{:keys [product_number total_time state audio_format multimedia_type
            date id produced_date volumes] :as production}]
   (->> [(create-row 2 product_number)
-        (create-row 233 (quot total_time (* 1000 60))) ; in minutes
+        (create-row 239 (quot total_time (* 1000 60))) ; in minutes
         (create-row 106 state)
-        (create-row 276 audio_format)
-        ;; FIXME: the number of CDs is only determined at the time of
-        ;; archiving. Is this persisted in the db?
-        (create-row 275 volumes) ; Number of CDs
-        (create-row 277 multimedia_type)
-        (create-row 252 (format date-format produced_date)) ; Date of production end
-        (create-row 274 (format date-format date)) ; Date of production start
+        (create-row 280 audio_format)
+        (create-row 271 volumes) ; Number of CDs
+        (create-row 281 multimedia_type)
+        (create-row 256 (format date-format produced_date)) ; Date of production end
+        (create-row 278 (format date-format date)) ; Date of production start
         (create-row 4 (prod/dam-number production))] ; for legacy purposes
        (remove nil?) ; remove empty rows
        wrap-rows ; wrap the payload


add a deeper test for parse-pull

add a deeper test for parse-pull

--- test/hu/ssh/github_changelog/conventional_test.clj
+++ test/hu/ssh/github_changelog/conventional_test.clj
@@ -34,4 +34,13 @@
   (testing "with invalid formats"
     (are [title] (nil? (conventional/parse-pull config (create-pull title)))
                  "this is just a PR"
-                 "does not follow the rules")))
+                 "does not follow the rules"))
+  (testing "with a full test"
+    (let [pull (merge (create-pull "feat(the scope): subject line") {:body "Fixes #1, Closes JIRA-2"})
+          change (conventional/parse-pull config pull)]
+      (is (s/validate Change change))
+      (is (= "feat" (:type change)))
+      (is (= "the scope" (:scope change)))
+      (is (= "subject line" (:subject change)))
+      (is (= pull (:pull-request change)))
+      (is (= 2 (count (:issues change)))))))


Simplify prototype input

Simplify prototype input

--- test/javascript_externs_generator/extern_test.cljs
+++ test/javascript_externs_generator/extern_test.cljs
@@ -31,6 +31,6 @@
     (compare! expected js-string)))

 (deftest prototype
-  (let [js-string "var TEST = {testFunction: function(){}}; TEST.testFunction.prototype = {testPrototypeFunction: function() {}}"
+  (let [js-string "var TEST = {testFunction: function(){}}; TEST.testFunction.prototype.testPrototypeFunction = function(){}"
         expected "var TEST = {\"testFunction\": function () {}};TEST.testFunction.prototype = {\"testPrototypeFunction\": function () {}};"]
     (compare! expected js-string)))


Add more tests for smart method resolution

--- test/caesium/binding_test.clj
+++ test/caesium/binding_test.clj
@@ -134,4 +134,18 @@
     '(b/✨ open-easy m c n pk sk)
     `(.crypto_box_open_easy
       b/sodium ~'m ~'c (long (bb/buflen ~'c)) ~'n ~'pk ~'sk)
-    [buf-tag buf-tag nil buf-tag buf-tag buf-tag]))
+    [buf-tag buf-tag nil buf-tag buf-tag buf-tag]
+
+    'caesium.crypto.generichash
+    `(b/✨ generichash buf msg key)
+    `(.crypto_generichash
+      b/sodium
+      ~'buf (long (bb/buflen ~'buf))
+      ~'msg (long (bb/buflen ~'msg))
+      ~'key (long (bb/buflen ~'key)))
+    [buf-tag nil buf-tag nil buf-tag nil]
+
+    'caesium.crypto.scalarmult
+    '(b/✨ scalarmult-base q n)
+    `(.crypto_scalarmult_base b/sodium ~'q ~'n)
+    [buf-tag buf-tag]))


Use x as var for now

Use x as var for now

Later, I'll need to walk the tree to find which variables are logic
variables that should be fresh.


Better polygon construction & tidy face connectivity

--- src/wireframes/shape_loader.clj
+++ src/wireframes/shape_loader.clj
@@ -1,5 +1,6 @@
 (ns wireframes.shape-loader
   (:require [clojure.string :as str]
+            [wireframes.transform :as t]
             [wireframes.shape-primitives :as sp]
             [wireframes.bezier-patch :as bp]))

@@ -22,46 +23,51 @@
   (let [f (partial parse-csv (comp dec parse-int))]
     (mapv f patch-data)))

-(defn- calculate-destination-index [source-index [dir offset] i j divisions]
+(defn- calculate-destination-index [source-index [dir offset] i j num-points]
   (cond
-    (and (= dir :north) (= j 0)) nil
-    (and (= dir :east)  (= i (dec divisions))) nil
-    (and (= dir :south) (= j (dec divisions))) nil
-    (and (= dir :west)  (= i 0)) nil
+    (and (= dir :east)  (= i (dec num-points))) nil
+    (and (= dir :south) (= j (dec num-points))) nil
     :else (+ source-index offset)))

-(defn face-connectivity [divisions]
+(defn face-connectivity [num-points]
   (vec
     (distinct
+      (for [j (range num-points)
+            i (range num-points)
+            dir { :east 1 :south num-points }
+            :let [src  (+ i (* j num-points))
+                  dest (calculate-destination-index src dir i j num-points)]
+            :when dest]
+        [src dest]))))
+
+(defn polygons [divisions]
+  (vec
+    (apply concat
       (for [j (range divisions)
             i (range divisions)
-            dir {
-                 ;:north (- divisions)
-                 :east 1
-                 :south divisions
-                 ;:west  -1
-                 }
-            :let [src  (+ i (* j divisions))
-                  dest (calculate-destination-index src dir i j divisions)]
-            :when dest]
-        (if (< src dest) [src dest] [dest src])))))
+            :let [
+                  a (+ i (* j (inc divisions)))
+                  b (inc a)
+                  c (+ b divisions)
+                  d (inc c)]]
+        (t/triangulate [a b d c]))))) ; order of points is important

 (defn- create-surface [divisions vertices patch]
   {:points (bp/surface-points divisions vertices patch)
    :lines  (face-connectivity (inc divisions))
-   :polygons nil })
+   :polygons (polygons divisions)})

 (defn load-shape [file divisions]
   (let [raw-data    (vec (str/split-lines (slurp file)))
         num-patches (Integer/parseInt (raw-data 0))
-        patches     (create-patches (subvec raw-data 1 (inc num-patches)))
-        vertices    (create-vertices (subvec raw-data (+ num-patches 2)))]
+	patches     (create-patches (subvec raw-data 1 (inc num-patches)))
+	vertices    (create-vertices (subvec raw-data (+ num-patches 2)))]
       (->>
-        ;(take 2 (drop 5 patches))
-        patches
-        (map (partial create-surface divisions vertices))
-        (reduce sp/augment)
-        ; TODO: create polygons
+	;(take 2 (drop 5 patches))
+	patches
+	(map (partial create-surface divisions vertices))
+	(reduce sp/augment)
+	; TODO: create polygons
         )))

 (comment


CMR-1405: Fixed white space issue

CMR-1405: Fixed white space issue

--- system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -187,8 +187,8 @@
              "DIF no extension" c3-dif :dif nil
              "ISO MENDS no extension" c5-iso :iso19115 nil
              "SMAP ISO no extension" c7-smap :iso-smap nil
-             "ECHO10 .native extension"c1-echo :echo10 "native"
-             "DIF .native extension"c3-dif :dif "native"
+             "ECHO10 .native extension" c1-echo :echo10 "native"
+             "DIF .native extension" c3-dif :dif "native"
              "ISO MENDS .native extension" c5-iso :iso19115 "native"
              "SMAP ISO .native extension" c7-smap :iso-smap "native"))


support common headers

support common headers

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -241,11 +241,14 @@
   (try
     (let [exp-headers (str->map exp-headers #":")
           exp-body (if-not (str/blank? exp-body)
-                     (coerce-payload (replace-opts exp-body opts) (or (get exp-headers "Content-Type") "")))]
+                     (coerce-payload (replace-opts exp-body opts)
+                                     (or (get exp-headers "Content-Type") "")))]
       (-> test (update :url replace-opts opts)
           (update :headers str->map #":" opts false)
+          (update :headers merge (:common-headers options))
           (update :params str->map  [#"&|(\s*,\s*)" #"\s*=\s*"] opts true)
-          (update :payload #(-> % (replace-opts opts) ((if (:dont_parse_payload options) identity json->clj))))
+          (update :payload #(-> % (replace-opts opts)
+                                ((if (:dont_parse_payload options) identity json->clj))))
           (update :exp-status #(.intValue (Double/parseDouble %)))
           (assoc :exp-body exp-body :exp-headers exp-headers)))
     (catch Exception e
@@ -256,8 +259,7 @@
   (let [test (if (:error test) test (prepare-test test @opts))]
     (if (:error test) test
         (try
-          (let [resp (mk-request (if-let [host (@opts "host")]
-                                   (update test :headers assoc :host host) test))
+          (let [resp (mk-request test)
                 delta (verify-response resp test)
                 test (assoc test :time (/ (:request-time resp) 1000.0) :resp resp)]
             (if delta
@@ -400,7 +402,15 @@
                                      :script (format "tests[\"Status code is %1$s\"] = responseCode.code === %1$s;" (:exp-status t))})})})}))

 (defn- to-opts [args]
-  (apply hash-map (map-indexed #(if (even? %1) (subs %2 1) %2) args)))
+  (->> args
+       (partition 2)
+       (reduce (fn [[result [k v]]]
+                 (let [k (if-not (.startsWith k ":")
+                           (do (log/warn "argument key expected to start with :" k) k)
+                           (subs k 1))]
+                   (if (.startsWith k "headers.")
+                     (update result :common-headers assoc (str/replace-first "headers." "") v)
+                     (assoc result k v)))) {})))

 (defn run-tests [args]
   (let [pool-size (Integer/parseInt (or (System/getProperty "thread-pool-size") "4"))]


variable name change

variable name change

--- src/shuppet/git.clj
+++ src/shuppet/git.clj
@@ -144,11 +144,11 @@
      (.call))
     (info "Fetching completed.")
     (let [repo (.getRepository git)
-          origin-master (.resolve repo  (str "origin/" branch))]
-      (info "Merging " origin-master)
+          origin-branch (.resolve repo  (str "origin/" branch))]
+      (info "Merging " origin-branch)
       (->
        (.merge git)
-       (.include origin-master)
+       (.include origin-branch)
        (.call))
       (info "Merge completed."))))


Implement printing for most EDN types.

Implement printing for most EDN types.

This includes support for a TaggedValue protocol which should be
extended by types which have no representation in basic EDN types.

--- src/vault/print.clj
+++ src/vault/print.clj
@@ -22,7 +22,7 @@
 (defn- color-text
   "Constructs a text doc, which may be colored if *colored-output* is true."
   [text & codes]
-  (if *colored-output*
+  (if (and *colored-output* (not (empty? codes)))
     [:span [:pass (ansi/esc codes)] text [:pass (ansi/escape :none)]]
     text))

@@ -34,13 +34,47 @@

+;; TOTAL-ORDERING COMPARATOR
+
+(defn total-order
+  "Comparator function that provides a total-ordering of EDN values."
+  [a b]
+  (compare (pr-str a) (pr-str b))) ; FIXME: dirty hack
+
+
+
+;; EDN-TAGGED PROTOCOL
+
+(defprotocol TaggedValue
+  (edn-tag [this] "Return the tag symbol to apply to the value.")
+  (edn-value [this] "Return the value to pass to the tag."))
+
+
+(extend-protocol TaggedValue
+  java.util.Date
+  (edn-tag [this] 'inst)
+  (edn-value [this]
+    (let [utc-format (doto (java.text.SimpleDateFormat.
+                             "yyyy-MM-dd'T'HH:mm:ss.SSS-00:00")
+                       (.setTimeZone (java.util.TimeZone/getTimeZone "GMT")))]
+      (.format utc-format this))))
+
+
+
 ;; DISPATCH MULTIMETHOD
+
+(defn- canonize-dispatch
+  [value]
+  (if (extends? TaggedValue (class value))
+    :tagged-value
+    (type value)))
+

 (defmulti canonize
   "Converts the given value into a 'canonical' structured document, suitable
   for printing with fipp. This method also supports ANSI color escapes for
   syntax highlighting if desired."
-  type)
+  #'canonize-dispatch)

 (defmacro ^:private color-primitive
@@ -50,33 +84,64 @@
      (color-text (pr-str value#) ~@codes)))

-(color-primitive nil :red)
-(color-primitive java.lang.Boolean :bold :blue)
-(color-primitive java.lang.Number :cyan)
+(color-primitive nil :bold :black)
+(color-primitive java.lang.Boolean :cyan)
+(color-primitive java.lang.Number :green)
 (color-primitive java.lang.Character :bold :magenta)
 (color-primitive java.lang.String :bold :magenta)
 (color-primitive clojure.lang.Keyword :bold :yellow)
+(color-primitive clojure.lang.Symbol)

 (defmethod canonize clojure.lang.ISeq
   [s]
-  [:group
-   (delimiter "(")
-   [:align (interpose :line (map canonize s))]
-   (delimiter ")")])
+  (let [elements (if (symbol? (first s))
+                   (cons (color-text (str (first s)) :bold :blue)
+                         (map canonize (rest s)))
+                   (map canonize s))]
+    [:group
+     (delimiter "(")
+     [:align (interpose :line elements)]
+     (delimiter ")")]))

-; vector
+(defmethod canonize clojure.lang.IPersistentVector
+  [v]
+  [:group
+   (delimiter "[")
+   [:align (interpose :line (map canonize v))]
+   (delimiter "]")])

-; Maps should print their entries in sorted key order.

-; Canonical sets should print their entries in sorted order.
+(defmethod canonize clojure.lang.IPersistentSet
+  [s]
+  (let [entries (sort total-order (seq s))]
+    [:group
+     (delimiter "#{")
+     [:align (interpose :line (map canonize entries))]
+     (delimiter "}")]))

+
+(defmethod canonize clojure.lang.IPersistentMap
+  [m]
+  (let [entries (sort-by first total-order (seq m))
+        entries (for [[k v] entries]
+                  [:span (canonize k) " " (canonize v)])]
+    [:group
+     (delimiter "{")
+     [:align (interpose [:span "," :line] entries)]
+     (delimiter "}")]))
+
+
+(defmethod canonize :tagged-value
+  [v]
+  [:span (color-text (str \# (edn-tag v)) :red) " " (canonize (edn-value v))])

 (defmethod canonize :default
   [value]
-  [:text (str \< (.getName (class value)) \space (pr-str value) \>)])
+  [:span "<" (color-text (.getName (class value)) :green)
+   (str \space (pr-str value) \>)])

 (defprinter cprint canonize {:width 80})


transforming disk format

transforming disk format

--- src/vc/provider.clj
+++ src/vc/provider.clj
@@ -69,7 +69,7 @@
   "Convert the general model into a vc specific one"
   (-> (merge machine vcenter {:system-id system-id})
       (mappings {:os :template})
-      (transform {:template (os->template :vcenter)})
+      (transform {:template (os->template :vcenter) :disk-format keyword})
       selections
       ))


Remove redundancy

Remove redundancy

--- src/yada/schema.clj
+++ src/yada/schema.clj
@@ -426,7 +426,6 @@
           Methods
           Responses
           SecurityHeaders
-          ResourceDocumentation
           {(s/optional-key :path-info?) Boolean
            (s/optional-key :sub-resource) (s/=> Resource Context)}
           Logger


better JSON parsing exception logging

better JSON parsing exception logging

--- Clojure-Websockets/TwitterClient/src/clj/birdwatch_tc/twitterclient/processing.clj
+++ Clojure-Websockets/TwitterClient/src/clj/birdwatch_tc/twitterclient/processing.clj
@@ -40,16 +40,22 @@
 (defn- tweet?
   "Checks if data is a tweet. If so, pass on, otherwise log error."
   [data]
-  (let [text (:text data)]
-    (when-not text (log/error "error-msg" data))
-    text))
+  (if-let [text (:text data)]
+    text
+    (when data (log/error "error-msg" data))))
+
+(defn parse-json
+  [chunk]
+  (try
+    (json/read-json chunk)
+    (catch Exception ex (log/error "Exception while parsing JSON" ex "\n" chunk))))

 (defn process-chunk
   "Creates composite transducer for processing tweet chunks. Last-received atom passed in for updates."
   [last-received]
   (comp
    (streaming-buffer)
-   (map json/read-json)
+   (map parse-json)
    (filter tweet?)
    (log-count last-received)))


Added in-hash serialization test.

Added in-hash serialization test.

--- test/carmine/test/core.clj
+++ test/carmine/test/core.clj
@@ -244,8 +244,12 @@
                       '("pmessage"    "ps-*"   "ps-baz" "five")]))))

 (deftest test-serialization
-  (let [k (test-key "stress-data")]
-    (wc (r/set k ser/stress-data))
-    (is (= ser/stress-data (wc (r/get k))))))
+  (let [k1 (test-key "stress-data")
+        k2 (test-key "stress-data-hash")]
+    (wc (r/set k1 ser/stress-data))
+    (is (= ser/stress-data (wc (r/get k1))))
+    (wc (r/hmset k2 "field1" ser/stress-data "field2" "just a string"))
+    (is (= ser/stress-data (wc (r/hget k2 "field1"))))
+    (is (= "just a string" (wc (r/hget k2 "field2"))))))

 (clean-up!) ; Leave with a fresh db


State key tests

State key tests

--- test/exploud/util_test.clj
+++ test/exploud/util_test.clj
@@ -63,3 +63,15 @@
                           :key2 false
                           :key3 nil}) => {:key1 "something"
                                           :key2 false})
+
+(fact "that getting the previous state key is correct when undo isn't set"
+      (previous-state-key {}) => :previous-state)
+
+(fact "that getting the previous state key is correct when undo is set"
+      (previous-state-key {:undo true}) => :new-state)
+
+(fact "that getting the new state key is correct when undo isn't set"
+      (new-state-key {}) => :new-state)
+
+(fact "that getting the new state key is correct when undo is set"
+      (new-state-key {:undo true}) => :previous-state)


GAWB-2189: moar changes

GAWB-2189: moar changes

--- src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
+++ src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
@@ -47,12 +47,12 @@
    (fn [{:keys [props state]} & [method-ref]]
      (let [{:keys [namespace name snapshotId]} (or method-ref props)]
        (endpoints/call-ajax-orch
-         {:endpoint (endpoints/get-agora-method namespace name snapshotId)
-          :headers utils/content-type=json
-          :on-done (fn [{:keys [success? get-parsed-response status-text]}]
-                     (if success?
-                       (swap! state assoc :loaded-method (utils/log (get-parsed-response)))
-                       (swap! state assoc :error status-text)))})))})
+        {:endpoint (endpoints/get-agora-method namespace name snapshotId)
+         :headers utils/content-type=json
+         :on-done (fn [{:keys [success? get-parsed-response status-text]}]
+                    (if success?
+                      (swap! state assoc :loaded-method (get-parsed-response))
+                      (swap! state assoc :error status-text)))})))})

 (defn- input-output-list [{:keys [values ref-prefix invalid-values editing? all-values]}]
@@ -123,7 +123,7 @@
                                                          " to the Google Bucket associated with this workspace."))
                                    :on-success (:on-submission-success props)})])
          (this :-render-main)
-         (clear-both)]]))
+         (common/clear-both)]]))
    :-render-sidebar
    (fn [{:keys [props state this]}]
      (let [{:keys [editing? loaded-config inputs-outputs]} @state
@@ -136,7 +136,7 @@
                   :top (when-not (:sidebar-visible? @state) 4)
                   :width 290}}
          (let [{:keys [locked?]} @state
-               can-edit? (access-greater-than? (:access-level props) "READER")
+               can-edit? (common/access-greater-than? (:access-level props) "READER")
                snapshot-id (get-in config [:methodRepoMethod :methodVersion])
                config-id (ws-common/config->id config)]
            [:div {}
@@ -170,8 +170,8 @@
                [comps/SidebarButton {:color :exception-state :margin :top
                                      :text "Cancel Editing" :icon :cancel
                                      :onClick (fn []
-                                                (this :cancel-editing)
-                                                (swap! state assoc :editing? false))}]))]))]))
+                                                (swap! state assoc :editing? false)
+                                                (this :cancel-editing))}]))]))]))
    :-render-main
    (fn [{:keys [state this]}]
      (let [{:keys [editing? loaded-config wdl-parse-error inputs-outputs methods]} @state
@@ -198,7 +198,7 @@
            (style/create-identity-select {:ref "rootentitytype"
                                           :defaultValue (:rootEntityType config)
                                           :style {:width 500}}
-                                         root-entity-types)
+                                         common/root-entity-types)
            [:div {:style {:padding "0.5em 0 1em 0"}} (:rootEntityType config)]))
         [:datalist {:id "inputs-datalist"}
          [:option {:value "this."}]
@@ -247,11 +247,12 @@
    (fn [{:keys [props state refs]}]
      (let [{:keys [workspace-id]} props
            config (-> @state :loaded-config :methodConfiguration)
-           [name root-entity-type] (get-text refs "confname" "rootentitytype")
+           [name root-entity-type] (common/get-text refs "confname" "rootentitytype")
            deref-vals (fn [io-key ref-prefix]
                         (->> (io-key (:inputs-outputs @state))
                              (map :name)
-                             (map (juxt identity #(get-text refs (str ref-prefix "_" %))))
+                             (map (juxt identity #(common/get-text refs (str ref-prefix "_" %))))
+                             (remove (comp empty? val))
                              (into {})))]
        (swap! state assoc :blocker "Updating...")
        (endpoints/call-ajax-orch
@@ -288,13 +289,13 @@
                                      (swap! state assoc :error (:message (get-parsed-response)))))}))
                     (swap! state assoc :error status-text)))}))
    :load-new-method-template
-   (fn [{:keys [state refs props]} new-snapshot-id]
+   (fn [{:keys [state refs]} new-snapshot-id]
      (let [[method-namespace method-name] (map (fn [key]
                                                  (get-in (:loaded-config @state)
                                                          [:methodConfiguration :methodRepoMethod key]))
                                                [:methodNamespace :methodName])
            config-namespace+name (select-keys (get-in @state [:loaded-config :methodConfiguration])
-                                              [:namespace :name :rootEntityType])
+                                              [:namespace :name])
            method-ref {:methodNamespace method-namespace
                        :methodName method-name
                        :methodVersion new-snapshot-id}]


bump example pipeline to new snapshot

bump example pipeline to new snapshot

--- example-pipeline/project.clj
+++ example-pipeline/project.clj
@@ -4,7 +4,7 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.7.0"]
-                 [lambdaui "0.1.0-SNAPSHOT"]
+                 [lambdaui "0.1.1-SNAPSHOT"]
                  [lambdacd "0.9.0"]
                  [lambdacd-git "0.1.6"]
                  [http-kit "2.1.18"]]


Cleanup tests

Cleanup tests

--- test/cljc/reitit/ring_test.cljc
+++ test/cljc/reitit/ring_test.cljc
@@ -17,6 +17,12 @@
        #(respond (update % :body (fnil conj []) name))
        raise))))

+(defn handler
+  ([{:keys [::mw]}]
+   {:status 200 :body (conj mw :ok)})
+  ([request respond raise]
+   (respond (handler request))))
+
 (deftest ring-test

   (testing "simple-router"
@@ -29,11 +35,6 @@

     (testing "ring-handler"
       (let [api-mw #(mw % :api)
-            handler (fn handle
-                      ([{:keys [::mw]}]
-                       {:status 200 :body (conj mw :ok)})
-                      ([request respond raise]
-                       (respond (handle request))))
             router (ring/simple-router
                      [["/ping" handler]
                       ["/api" {:middleware [api-mw]}
@@ -77,11 +78,6 @@

     (testing "ring-handler"
       (let [api-mw #(mw % :api)
-            handler (fn handle
-                      ([{:keys [::mw]}]
-                       {:status 200 :body (conj mw :ok)})
-                      ([request respond raise]
-                       (respond (handle request))))
             router (ring/method-router
                      [["/api" {:middleware [api-mw]}
                        ["/all" handler]


Connection timeout test.

Connection timeout test.

--- test/http/async/client/test.clj
+++ test/http/async/client/test.clj
@@ -35,7 +35,8 @@
            (java.io ByteArrayOutputStream
                     File
                     IOException)
-           (java.net ServerSocket)
+           (java.net ServerSocket
+                     ConnectException)
            (java.nio.channels UnresolvedAddressException)
            (java.util.concurrent TimeoutException)))
 (set! *warn-on-reflection* true)
@@ -598,6 +599,14 @@
         (when (failed? resp)
           (println "No response received, while excepting it." (.getMessage ^Throwable (error resp))))))))

+(deftest connection-timeout
+  ;; timeout connection after 1ms
+  (with-open [client (create-client :connection-timeout 1)]
+    (let [resp (GET client "http://localhost:8124/")]
+      (await resp)
+      (is (true? (failed? resp)))
+      (is (instance? ConnectException (error resp))))))
+
 (deftest closing-client
   (let [client (create-client)
         _ (await (GET client "http://localhost:8123/"))]


Add tests for encode/decode helpers.

Add tests for encode/decode helpers.

--- test/multistream/codec_test.clj
+++ test/multistream/codec_test.clj
@@ -64,3 +64,21 @@
             (is (= headers (::codec/headers decoder)))
             (is (= "hello multistream, how are you?"
                    (codec/read! decoder)))))))))
+
+
+(deftest byte-encoding-utils
+  (testing "direct codec use"
+    (let [codec (text-codec)
+          byte-arr (codec/encode codec "nuke-a-cola")]
+      (is (= 24 (count byte-arr)))
+      (is (= "nuke-a-cola" (codec/decode codec byte-arr)))
+      (is (thrown-with-msg? Exception #"processable codec header"
+            (codec/decode (bin-codec) byte-arr)))))
+  (testing "factory selection"
+   (let [factory (codec/multi
+                  :foo (transform-codec "/foo/" :encode-fn str/upper-case)
+                  :text (text-codec)
+                  :gzip (gzip-codec))
+         byte-arr (codec/encode factory [:foo :gzip :text] "nuke-a-cola")]
+      (is (= 59 (count byte-arr)))
+      (is (= "NUKE-A-COLA" (codec/decode factory byte-arr))))))


Try and setup the database before test.

Try and setup the database before test.

--- test/takehome/unit/web.clj
+++ test/takehome/unit/web.clj
@@ -61,4 +61,10 @@
        (let [resp (request :post "/kittens_and_puppies" {:params {:message "http://cuteoverload.files.wordpress.com/2014/10/unnamed23.jpg?w=750&h=1000"}})]
          (:status resp) => 404))

+ (fact "Retrieve the next message from a topic"
+       (empty_messages)
+       (let [resp (request :get "/kittens_and_puppies/alice")]
+         (:status resp) => 200
+         (get-in resp [:body :name]) => "foo"))
+
 )


PCP-147 Add core/expand-destinations test

Here we add a unit test for core/expand-destinations, and correct our mock
find-clients to return () rather than true, so we are returning an empty list
by default.

--- test/unit/puppetlabs/pcp/broker/core_test.clj
+++ test/unit/puppetlabs/pcp/broker/core_test.clj
@@ -16,7 +16,7 @@
                 :delivery-consumers 2
                 :activemq-consumers (atom [])
                 :record-client      (constantly true)
-                :find-clients       (constantly true)
+                :find-clients       (constantly ())
                 :authorization-check (constantly true)
                 :uri-map            (atom {})
                 :connections        (atom {})
@@ -118,6 +118,20 @@
                                                                                :message message}))]
       (deliver-message broker capsule)
       (is (= "not connected" (:message @failure))))))
+
+(deftest expand-destinations-test
+  (let [broker (make-test-broker)
+        message (message/make-message :targets ["pcp://example01.example.com/foo"])
+        capsule (capsule/wrap message)
+        queued (atom [])]
+    (with-redefs [puppetlabs.pcp.broker.core/maybe-send-destination-report (constantly true)
+                  puppetlabs.pcp.broker.activemq/queue-message (fn [queue capsule]
+                                                                 (swap! queued conj {:queue queue
+                                                                                :capsule capsule}))]
+      (expand-destinations broker capsule)
+      (is (= 1 (count @queued)))
+      (is (= delivery-queue (:queue (first @queued))))
+      (is (= "pcp://example01.example.com/foo" (:target (:capsule (first @queued))))))))

 (deftest make-ring-request-test
   (let [broker (make-test-broker)]


refactoring

refactoring

--- desktop/src-common/con_world/core.clj
+++ desktop/src-common/con_world/core.clj
@@ -27,9 +27,9 @@
   :on-render
   (fn [screen entities]
     (clear!)
-    (let [entities (step! screen entities)]
-      #_(println entities)
-      (render! screen entities)))
+    (->> entities
+         (step! screen)
+         (render! screen)))

   :on-key-down
     (fn [screen entities]


add clj-time

add clj-time

--- elephantdb-server/project.clj
+++ elephantdb-server/project.clj
@@ -28,6 +28,7 @@
              :dev
              {:dependencies
               [[ring-mock "0.1.3"]
+               [clj-time "0.6.0"]
                [midje "1.6.3"]]
               :plugins [[lein-midje "3.1.3"]]}}
   :aot :all


Remove redundant defn

Remove redundant defn

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

--- clojure/sequence_generator.clj
+++ clojure/sequence_generator.clj
@@ -8,15 +8,12 @@

 (defn pairs [x]
   (partition 2 1 (concat x [nil])))
-
-(defn first-not-nil [& args]
-  (first (filter (comp not nil?) args)))

 (defn get-skip-frames [channel]
-  (first-not-nil (:skip-frames channel) (.skipFactorFrame_ channel)))
+  (or (:skip-frames channel) (.skipFactorFrame_ channel)))

 (defn get-use-z-stack [channel]
-  (first-not-nil (:use-z-stack channel) (.doZStack_ channel)))
+  (or (:use-z-stack channel) (.doZStack_ channel)))

 (defn make-dimensions [settings]
   (let [{:keys [slices channels frames positions


fix path to goog/base.js

fix path to goog/base.js

--- env/dev/clj/clojexcms/dev.clj
+++ env/dev/clj/clojexcms/dev.clj
@@ -8,7 +8,7 @@
 (def inject-devmode-html
   (comp
    (set-attr :class "is-dev")
-   (prepend (html [:script {:type "text/javascript" :src "/js/out/goog/base.js"}]))
+   (prepend (html [:script {:type "text/javascript" :src "/js/backend/out/goog/base.js"}]))
    (append  (html [:script {:type "text/javascript"} "goog.require('clojexcms.dev')"]))
    (append  (html [:script {:type "text/javascript" :id "lt_ws"
                             :src "http://localhost:62439/socket.io/lighttable/ws.js"}]))))


solved #84 monopoly odds

solved #84 monopoly odds

--- Alfa/src/alfa/special/p84.clj
+++ Alfa/src/alfa/special/p84.clj
@@ -1,9 +1,85 @@
 (ns alfa.special.p84
   (:require
-   [clojure.set :refer [union difference intersection subset?]]
-   [clojure.core.reducers :as r]
-   [clojure.string :refer [split-lines]]
-   [alfa.common :refer :all]
-   [clojure.string :as cs]))
+    [clojure.set :refer [union difference intersection subset?]]
+    [clojure.core.reducers :as r]
+    [clojure.string :refer [split-lines]]
+    [alfa.common :refer :all]
+    [clojure.string :as cs]))
+
+(def board [:GO :A1 :CC1 :A2 :T1 :R1 :B1 :CH1 :B2 :B3
+            :JAIL :C1 :U1 :C2 :C3 :R2 :D1 :CC2 :D2 :D3
+            :FP :E1 :CH2 :E2 :E3 :R3 :F1 :F2 :U2 :F3
+            :G2J :G1 :G2 :CC3 :G3 :R4 :CH3 :H1 :T2 :H2])
+
+(def b2i (zipmap board (range)))
+
+(def i2b (zipmap (range) board))

+(def cc-cards (atom (shuffle (concat [:JAIL :GO] (repeat 14 0)))))
+
+(def ch-cards (atom (shuffle (concat (repeat 6 0)
+                                     [:GO :JAIL :C1 :E3 :H2 :R1]
+                                     (repeat 2 :next-r)
+                                     [:next-u -3]))))
+
+(defn dice-4
+  []
+  (inc (rand-int 4)))
+
+(defn land-on
+  [init dices]
+  (i2b (rem (+ dices (b2i init)) 40)))
+
+(defn move
+  [init double]
+  (let [d1 (dice-4) d2 (dice-4) ds (+ d1 d2)]
+    (if (== d1 d2)
+      (if (<= 0 double 1)
+        [(land-on init ds) (inc double)]
+        [:JAIL 0])
+      [(land-on init ds) 0])))
+
+(defn next-r
+  [land]
+  (first (filter #{:R1 :R2 :R3 :R4} (drop (inc (b2i land)) (cycle board)))))
+
+(defn next-u
+  [land]
+  (first (filter #{:U1 :U2} (drop (inc (b2i land)) (cycle board)))))
+
+(defn block
+  [land]
+  (cond
+    (some #{land} [:CC1 :CC2 :CC3])
+    (let [card (first @cc-cards)]
+      (do (reset! cc-cards (concat (rest @cc-cards) [(first @cc-cards)]))
+          (if (integer? card) (land-on land card) card)))
+    (some #{land} [:CH1 :CH2 :CH3])
+    (let [card (first @ch-cards)]
+      (do (reset! ch-cards (concat (rest @ch-cards) [(first @ch-cards)]))
+          (cond
+            (= -3 card) (block (i2b (- (b2i land) 3)))
+            (integer? card) (land-on land card)
+            (= card :next-r) (next-r land)
+            (= card :next-u) (next-u land)
+            :else card)))
+    (= land :G2J) :JAIL
+    :else land))
+
+(defn play
+  [lim]
+  (loop [i (int 0) pos :GO double 0 moves {}]
+    (if (> i lim)
+      (map #(let [[a b] %]
+             [(b2i a) b]) (sort-by val > moves))
+      (let [[npos1 ndouble] (move pos double)
+            npos (block npos1)]
+        (recur (inc i) npos ndouble (merge-with + moves {npos 1}))))))
+
+
+
+
+
+
+


CMR-1022: Added additional tests for keyword search.

--- system-int-test/test/cmr/system_int_test/search/collection_keyword_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_keyword_search_test.clj
@@ -83,6 +83,9 @@

            ;; Checking specific fields

+           ;; provier
+           "PROV1" [coll1 coll2 coll3 coll23]
+
            ;; entry title
            "coll1" [coll1]

@@ -132,7 +135,10 @@
            "some" [coll6]

            ;; attributes
+           ;; - name
            "charlie" [coll12]
+           ;; - description
+           "Generated" [coll12]

            ;; Platforms
            ;; - short name
@@ -155,6 +161,7 @@
            "ssnA" [coll15]
            ;; - long name
            "slnB" [coll11]
+           ;; - technique
            "techniqueB" [coll11]

            ;; Science keywords


Revert the change to use the pure-java SQLite JDBC driver.

This causes nearly every request to time out.

--- src/clojars/db.clj
+++ src/clojars/db.clj
@@ -42,9 +42,6 @@

 (defn bcrypt [s]
   (creds/hash-bcrypt s :work-factor (:bcrypt-work-factor config)))
-
-;; work around segfault bug: https://github.com/ato/clojars-web/issues/115
-(System/setProperty "sqlite.purejava", "true")

 (defdb mydb (:db config))
 (defentity users)


Rename allowed-user? with authenticate-user

This function is determining the user's existence and roles, rather than
whether the user is allowed to proceed with the request in context.

--- src/cylon/core.clj
+++ src/cylon/core.clj
@@ -90,11 +90,11 @@
     (when this {})))

 (defprotocol UserAuthenticator
-  (allowed-user? [_ user password]))
+  (authenticate-user [_ user password]))

 (extend-protocol UserAuthenticator
   Boolean
-  (allowed-user? [this user password] this))
+  (authenticate-user [this user password] this))

 (def PASSWORD_HASH_ALGO "PBKDF2WithHmacSHA1")

@@ -168,7 +168,7 @@
   (stop [this] this)

   UserAuthenticator
-  (allowed-user? [this uid pw]
+  (authenticate-user [this uid pw]
     (when-let [hash (get-hash-for-uid (:password-store this) uid)]
       (verify-password pw hash)
       ;; TODO There is a slight security concern here. If no uid is
@@ -250,7 +250,7 @@

 (defrecord MapBackedUserRegistry [m]
   UserAuthenticator
-  (allowed-user? [_ user password]
+  (authenticate-user [_ user password]
     ((set (seq m)) [user password])))

 (defn new-map-backed-user-registry [m]
@@ -301,7 +301,7 @@
         (let [[username password] (->> (String. (DatatypeConverter/parseBase64Binary basic-creds) "UTF-8")
                                        (re-matches #"(.*):(.*)")
                                        rest)]
-          (when (allowed-user? user-authenticator username password)
+          (when (authenticate-user user-authenticator username password)
             {::username username
              ::user-roles user-roles}))))))

@@ -369,7 +369,7 @@

     (if (and username
              (not-empty username)
-             (allowed-user? user-authenticator (.trim username) password))
+             (authenticate-user user-authenticator (.trim username) password))

       {:status 302
        :headers {"Location" (or requested-uri "/")} ; "/" can be parameterized (TODO)


Activate thread info output.

Activate thread info output.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -159,7 +159,7 @@
       (.start in-loop)
       (run-repeat (executor) (fn []
                                (stats-fn)
-                               ;(thread-info-fn) (println)
+                               (thread-info-fn) (println)
                                )
                   1000)
       (run-once (executor) (fn [] (System/exit 0)) 20000))))


Add Parent Id to Refs in Parsing

Add Parent Id to Refs in Parsing

--- src/lens/parse.clj
+++ src/lens/parse.clj
@@ -4,18 +4,26 @@
             [clojure.data.zip.xml :refer [xml-> xml1-> attr attr= text]]
             [clojure.tools.logging :as log]
             [clojure.zip :as zip]
+            [schema.core :as s :refer [Str]]
             [lens.event-bus :refer [publish!!]]))

-(defn oid [loc]
+;; ---- Schemas ---------------------------------------------------------------
+
+(def Xml
+  s/Any)
+
+;; ---- Private ---------------------------------------------------------------
+
+(defn- oid [loc]
   (xml1-> loc (attr :OID)))

-(defn first-translated-text []
+(defn- first-translated-text []
   (fn [loc] (xml1-> loc :TranslatedText text)))

-(defn desc [loc]
+(defn- desc [loc]
   (xml1-> loc :Description (first-translated-text)))

-(defn question [loc]
+(defn- question [loc]
   (xml1-> loc :Question (first-translated-text)))

 ;; ---- Form Ref --------------------------------------------------------------
@@ -25,8 +33,9 @@
        :mandatory (= "Yes" (xml1-> form-ref (attr :Mandatory)))}
       (assoc-when :order-number (xml1-> form-ref (attr :OrderNumber)))))

-(defn parse-form-ref! [bus form-ref]
-  (publish!! bus :form-ref (parse-form-ref form-ref)))
+(s/defn parse-form-ref! [bus parent-id :- Str form-ref :- Xml]
+  (->> (assoc (parse-form-ref form-ref) :parent-id parent-id)
+       (publish!! bus :form-ref)))

 ;; ---- Study Event Def -------------------------------------------------------

@@ -38,7 +47,7 @@
 (defn parse-study-event-def! [bus study-event-def]
   (publish!! bus :study-event-def (parse-study-event-def-head study-event-def))
   (doseq [form-ref (xml-> study-event-def :FormRef)]
-    (parse-form-ref! bus form-ref)))
+    (parse-form-ref! bus (oid study-event-def) form-ref)))

 ;; ---- Item Group Ref --------------------------------------------------------------

@@ -47,8 +56,9 @@
        :mandatory (= "Yes" (xml1-> item-group-ref (attr :Mandatory)))}
       (assoc-when :order-number (xml1-> item-group-ref (attr :OrderNumber)))))

-(defn parse-item-group-ref! [bus item-group-ref]
-  (publish!! bus :item-group-ref (parse-item-group-ref item-group-ref)))
+(s/defn parse-item-group-ref! [bus parent-id :- Str item-group-ref :- Xml]
+  (->> (assoc (parse-item-group-ref item-group-ref) :parent-id parent-id)
+       (publish!! bus :item-group-ref)))

 ;; ---- Form Def --------------------------------------------------------------

@@ -57,10 +67,10 @@
        :name (xml1-> form-def (attr :Name))}
       (assoc-when :desc (desc form-def))))

-(defn parse-form-def! [bus form-def]
+(s/defn parse-form-def! [bus form-def :- Xml]
   (publish!! bus :form-def (parse-form-def-head form-def))
   (doseq [item-group-ref (xml-> form-def :ItemGroupRef)]
-    (parse-item-group-ref! bus item-group-ref)))
+    (parse-item-group-ref! bus (oid form-def) item-group-ref)))

 ;; ---- Item Ref --------------------------------------------------------------

@@ -69,8 +79,9 @@
        :mandatory (= "Yes" (xml1-> item-ref (attr :Mandatory)))}
       (assoc-when :order-number (xml1-> item-ref (attr :OrderNumber)))))

-(defn parse-item-ref! [bus item-ref]
-  (publish!! bus :item-ref (parse-item-ref item-ref)))
+(s/defn parse-item-ref! [bus parent-id :- Str item-ref :- Xml]
+  (->> (assoc (parse-item-ref item-ref) :parent-id parent-id)
+       (publish!! bus :item-ref)))

 ;; ---- Item Group Def --------------------------------------------------------

@@ -79,10 +90,10 @@
        :name (xml1-> item-group-def (attr :Name))}
       (assoc-when :desc (desc item-group-def))))

-(defn parse-item-group-def! [bus item-group-def]
+(s/defn parse-item-group-def! [bus item-group-def :- Xml]
   (publish!! bus :item-group-def (parse-item-group-def-head item-group-def))
   (doseq [item-ref (xml-> item-group-def :ItemRef)]
-    (parse-item-ref! bus item-ref)))
+    (parse-item-ref! bus (oid item-group-def) item-ref)))

 ;; ---- Item Def --------------------------------------------------------------


add mdl-grid no spacing for projects

add mdl-grid no spacing for projects

--- app/src/cljs/app/components.cljs
+++ app/src/cljs/app/components.cljs
@@ -68,10 +68,9 @@
   [projects]
   [:div#projects
    [section-component
-    [:div.projectsheader.mdl-grid
-     [:div.mdl-cell.mdl-cell--12-col
-      [:h3 "Projects"]]
-     (into [:div.project] (map #(single-project-component %) projects))]]])
+    [:div.projectsheader.mdl-grid--no-spacing
+     [:h3.mdl-cell.mdl-cell--12-col "projects"]
+     (into [:div.project.mdl-cell.mdl-cell--4-col] (map #(single-project-component %) projects))]]])

 (defn single-employment-component
   [employment]


fixed sourcing in of .mapfsrc to read entire file

--- src/mapfs/core.clj
+++ src/mapfs/core.clj
@@ -263,12 +263,22 @@
     (slurp f)
     ))

+(defn read-file
+  "Sources in a file by reading/evaluating it as clojure code."
+  [filename]
+  (let [pbr (java.io.PushbackReader. (java.io.StringReader. (slurp filename)))]
+    (loop [o (read pbr false nil)]
+      (when o
+        (eval o)
+        (recur (read pbr false nil))))))
+
 (defn- read-mapfsrc []
+  "Initialize mapfs with ~/.mapfsrc if it exists"
   (let [rcfilename (str (System/getProperty "user.home") java.io.File/separator ".mapfsrc")
         f (java.io.File. rcfilename) ]
     (when (.exists f)
       (println "evaluating .mapfsrc: " rcfilename)
-      (eval (read-string (slurp rcfilename))))) )
+      (read-file rcfilename))))

 (defn -main [& args]
   (println "Map FS - 0.1.0")
@@ -279,7 +289,7 @@
         [term console] (init-terminal)]
     (push-thread-bindings bindings)
     (in-ns 'mapfs.core)
-    (println (read-mapfsrc))
+    (read-mapfsrc)
     (loop []
       (println)
       (let [v (.readLine @CONSOLE "mapfs> ")]


full-stack example can use deployed cellophane dep

--- fullstack_example/project.clj
+++ fullstack_example/project.clj
@@ -11,7 +11,7 @@
                  [com.datomic/datomic-free "0.9.5344"]
                  [hiccup "1.0.5"]
                  [bidi "1.25.0"]
-                 [com.ladderlife/cellophane "0.1.0-SNAPSHOT"]
+                 [com.ladderlife/cellophane "0.1.0"]
                  [org.omcljs/om "1.0.0-alpha30"]
                  [ring/ring "1.4.0"]
                  [ring/ring-headers "0.2.0"]


[up] add dummy route for moneyout submitting.

--- src/ombs/route.clj
+++ src/ombs/route.clj
@@ -42,6 +42,7 @@
   (POST "/addevent" {params :params} (init-event params))

   (GET "/moneyout" [_] (pages/moneyout))
+  (POST "/moneyout" {params :params} (json/generate-string params))

   (GET  "/user" [_] (pages/user))


CMR-1803: Integrate highlights into search results

--- search-app/src/cmr/search/services/query_execution/highlight_results_feature.clj
+++ search-app/src/cmr/search/services/query_execution/highlight_results_feature.clj
@@ -5,22 +5,14 @@
             [cmr.search.models.results :as r]
             [clojure.string :as str]))

-(comment
-  (def the-query (cmr.common.dev.capture-reveal/reveal query))
-
-  (get-keyword-conditions (:condition the-query))
-  (build-highlight-query the-query)
-  )
-
 (defn- get-keyword-conditions
   "Returns a list of the keyword text conditions from a condition"
   [condition]
   (let [sub-condition (:condition condition)
         sub-conditions (:conditions condition)
-        all-sub-conditions (if sub-condition
-                             (conj sub-conditions sub-condition)
-                             sub-conditions)
-        keyword-sub-conditions (for [a-condition (seq all-sub-conditions)
+        keyword-sub-conditions (for [a-condition (if sub-condition
+                                                   (conj sub-conditions sub-condition)
+                                                   sub-conditions)
                                  :let [keyword-condition (get-keyword-conditions a-condition)]
                                  :when keyword-condition]
                                  keyword-condition)
@@ -32,7 +24,6 @@
 (defn- build-highlight-query
   "Creates the highlight query that will be passed into elastic"
   [query]
-  (cmr.common.dev.capture-reveal/capture query)
   (when-let [keyword-conditions (get-keyword-conditions (:condition query))]
     (let [conditions-as-string (str/join " " (map #(:query-str %) keyword-conditions))]
        {:fields {:summary {:highlight_query {:query_string {:query conditions-as-string}}}}})))
@@ -42,11 +33,21 @@
   (assoc query :highlights (build-highlight-query query)))

 (defn- replace-fields-with-highlighted-fields
-  "Replaces the appropriate fields with the highlighted snippets for each field."
+  "Replaces the appropriate fields with the highlighted snippets for each field.
+
+  Note this algorithm requires that both the number of hits and the order of results is identical
+  in the query-results and elastic-results."
   [query-results elastic-results]
-  query-results)
+  (let [all-highlights (map #(get-in % [:highlight :summary])
+                            (get-in elastic-results [:hits :hits]))]
+    (for [item (:items query-results)
+          :let [highlight (first all-highlights)
+                all-highlights (rest all-highlights)]]
+      (if (seq highlight)
+        (assoc item :summary (str/join ";" highlight))
+        item))))

 (defmethod query-execution/post-process-query-result-feature :highlights
   [context query elastic-results query-results feature]
-  (cmr.common.dev.capture-reveal/capture-all)
-  (replace-fields-with-highlighted-fields query-results elastic-results))
+  (assoc query-results
+         :items (replace-fields-with-highlighted-fields query-results elastic-results)))


Rename set-elev function to set-elev!

Rename set-elev function to set-elev!

Rename the local set-elev function in frontend.elevio/enable! to
set-elev! to reflect its side effecting nature

--- src-cljs/frontend/elevio.cljs
+++ src-cljs/frontend/elevio.cljs
@@ -16,10 +16,10 @@
 (defn enable! []
   (class-list/add js/document.body "circle-elevio")
   (aset js/window "_elev" (or (aget js/window "_elev") #js {}))
-  (let [set-elev (partial aset (aget js/window "_elev"))]
-    (set-elev "account_id" account-id)
-    (set-elev "user" (aget js/window "elevSettings"))
-    (set-elev "translations"
+  (let [set-elev! (partial aset (aget js/window "_elev"))]
+    (set-elev! "account_id" account-id)
+    (set-elev! "user" (aget js/window "elevSettings"))
+    (set-elev! "translations"
           #js {"loading"
                #js {"loading_ticket" "Loading support request"
                     "loading_tickets" "Loading support requests"


Add `multi?`

Add `multi?`

--- src/such/types.clj
+++ src/such/types.clj
@@ -28,11 +28,15 @@
   [x]
   (instance? java.math.BigDecimal x))

+(defn multi?
+  "Was `x` created with `defmulti`?"
+  [x]
+  (instance? clojure.lang.MultiFn x))
+
 (defn extended-fn?
   "`fn?` does not consider multimethods to be functions. This does."
   [x]
-  (or (fn? x)
-      (instance? clojure.lang.MultiFn x)))
+  (or (fn? x) (multi? x)))

 (defn named?
   "Will `name` work on x? Two cases: It implements the Named protocol OR it's a string."


int casts no longer needed with latest cljc.java-time

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -178,7 +178,7 @@
 (defn new-date
   ([] (today))
   ([year month day-of-month]
-   (cljc.java-time.local-date/of (clojure.core/int year) (clojure.core/int month) (clojure.core/int day-of-month)))
+   (cljc.java-time.local-date/of year month day-of-month))
   ([year day-of-year]
    (cljc.java-time.local-date/of-year-day year day-of-year))
   ([epoch-day]


Use some to check existence of item in collection

--- src/tttclj/web.clj
+++ src/tttclj/web.clj
@@ -16,21 +16,20 @@
   (successor g (rand-nth (possible-moves g))))

 (defn ws-handler [{:keys [ws-channel] :as req}]
-  (println (:async-channel req))
+  (println "Opened connection from" (:remote-addr req))
   (let [game (atom (create-game))]
+    ;; Let's send a new game straight away.
+    (go
+      (>! ws-channel (prep @game)))
+    ;; Wait for moves from client. Apply them, and send new board back.
     (go-loop []
-      (when-not (game-over? @game)
-        (let [move (:message (<! ws-channel))]
-          (when (contains? (apply vector (possible-moves @game)) move)
-            (swap! game #(successor % move))
-            (>! ws-channel (prep @game))
-            (<! (timeout 500))
-            (when-not (game-over? @game)
-              (swap! game make-random-move)
-              (>! ws-channel (prep @game))))))
-      (recur))
-    (go
-      (>! ws-channel (prep @game)))))
+      (when-let [{:keys [message error] :as msg} (<! ws-channel)]
+        (when-not error
+          (when (some #(= % message) (possible-moves @game))
+            (swap! game #(successor % message))
+            (>! ws-channel (prep @game))))
+        (when-not (game-over? @game)
+          (recur))))))

 (defroutes app
   (resources "/")