Add 'file-patho logic query to find paths to files.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1099,6 +1099,15 @@
      pldb/empty-db
      rel-data)))

+(defn file-patho
+  [tree-sha so-far fname fsha tree-path]
+  (l/conde
+   [(r-tree tree-sha fname :blob fsha) (l/== so-far tree-path)]
+   [(l/fresh [next-path next-sha new-path]
+             (r-tree tree-sha next-path :tree next-sha)
+             (l/conso next-path so-far new-path)
+             (file-patho next-sha new-path fname fsha tree-path))]))
+
 (comment
   (def xdb1 (pldb/db [r-tree :a :b :c :d]))
   (pldb/with-db xdb1 (l/run* [a] (r-tree a :b :c :d)))
@@ -1113,6 +1122,19 @@
           (rels->pldb [r-branch r-commit r-commit-parent r-tree r-proj]
                       (fress/read "tmp.frs" :handlers my-read-handlers))))
   (time (def x (fress/read "tmp.frs" :handlers my-read-handlers)))
+
+  (time
+   (let [fname "core.clj"]
+     (doall
+      (pldb/with-db db
+        (l/run 10 [c-sha tree-path obj-sha]
+               (l/fresh [tree-sha ctime p-sha p-ctime p-tree-sha p-obj-sha]
+                        (r-commit c-sha ctime tree-sha)
+                        (r-commit-parent c-sha p-sha)
+                        (r-commit p-sha p-ctime p-tree-sha)
+                        (file-patho p-tree-sha nil fname p-obj-sha tree-path)
+                        (file-patho tree-sha nil fname obj-sha tree-path)
+                        (l/!= obj-sha p-obj-sha)))))))

   (pldb/with-db db
     (l/run 10 [sha]


Don't trust git log filename filtering. Filter commit paths ourselves.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -332,10 +332,11 @@
 (defn project-change-shas
   [gitdir]
   (->> (git {:gitdir gitdir} "log" "--all" "--pretty=format:%H,%cd,%p,%d"
-            "--name-status" "-m" "--" "project.clj" "**/project.clj")
+            "--name-status" "-m")
        :lines
        (keep #(if-let [[_ op path] (re-matches #"(.)\t(.*)" %)]
-                {:op op :path path}
+                (when (re-find #"(^|/)project\.clj$" path)
+                  {:op op :path path})
                 (when (seq %)
                   (parse-sha-refs %))))
        (#(concat % [{:sha "end sigil"}]))
@@ -344,7 +345,8 @@
                        [entry partial]
                        [(update-in partial [:ops] (fnil conj []) entry) nil]))
                    [nil nil])
-       (keep second)))
+       (keep second)
+       (filter :ops)))

 (defn tag-repo-projects
   [gitdir]


[#2361] fix for git ignore pattern

[#2361] fix for git ignore pattern

--- src/lt/objs/files.cljs
+++ src/lt/objs/files.cljs
@@ -31,7 +31,7 @@

 (def ignore-pattern
   "Regex pattern consisting of files, folders, etc... to ignore."
-  #"(^\..*)|\.class$|target/|^[_.]svn$|^CVS$|\.git|\.pyc|~|\.swp|\.jar|.DS_Store")
+  #"(^\..*)|\.class$|target/|^[_.]svn$|^CVS$|^\.git$|\.pyc|~|\.swp|\.jar|.DS_Store")

 (declare files-obj)


Removed unused files/->type fn

Removed unused files/->type fn

--- src/lt/objs/files.cljs
+++ src/lt/objs/files.cljs
@@ -264,10 +264,6 @@
     (str f separator)
     (str f)))

-(defn ->type [path]
-  (let [e (ext path)]
-    (or (ext->mode path) e)))
-
 (defn ls [path cb]
   (try
     (let [fs (map (partial ->file|dir path) (.readdirSync fs path))]


Print pulse failure stack trace and give warning padding.

--- src/metabase/pulse.clj
+++ src/metabase/pulse.clj
@@ -1,7 +1,8 @@
 (ns metabase.pulse
   (:require [clojure.java.io :as io]
             (clojure [pprint :refer [cl-format]]
-                     [string :refer [upper-case]])
+                     [string :refer [upper-case]]
+                     [stacktrace :refer [print-stack-trace]])
             [clojure.tools.logging :as log]
             (clj-time [coerce :as c]
                       [core :as t]
@@ -415,10 +416,12 @@
                              :font-weight 700})}
         "We were unable to display this card." [:br] "Please view this card in Metabase."])]
     (catch Throwable e
-      (log/warn (str "Pulse card render error:" e))
+      (log/warn "Pulse card render error:")
+      (print-stack-trace e)
       [:div {:style (style font-style
                            {:color       "#EF8C8C"
-                            :font-weight 700})}
+                            :font-weight 700
+                            :padding     "16px"})}
        "An error occurred while displaying this card."])))


create ex wrapper stub

create ex wrapper stub

--- src/ontrail/mutate.clj
+++ src/ontrail/mutate.clj
@@ -59,3 +59,7 @@
   (if (valid? user-input-ex)
     (insert-exercise-inmem-index
      (mc/insert-and-return EXERCISE (from-user-ex user user-input-ex)))))
+
+(def create-ex-wrapper [cookies body]
+  (let [username (user-from-token (:value (cookies "authToken")))]
+    ))


Allow dest to be a string

Allow dest to be a string

--- src/postal/client.cljs
+++ src/postal/client.cljs
@@ -103,7 +103,8 @@
   [client {:keys [type dest data headers] :as opts}]
   {:pre [(or (map? data)
              (nil? data))
-         (keyword? dest)
+         (or (keyword? dest)
+             (string? dest))
          (client? client)]}
   (let [data (encode {:data data :dest dest :type type})
         req (prepare-request client data)]


No need to use ratoms, can use normal atoms.

--- src/re_frame/undo.cljs
+++ src/re_frame/undo.cljs
@@ -16,8 +16,8 @@
   (reset! max-undos n))

 ;;
-(def ^:private undo-list (reagent/atom []))   ;; a list of history states
-(def ^:private redo-list (reagent/atom []))   ;; a list of future states, caused by undoing
+(def ^:private undo-list (atom []))   ;; a list of history states
+(def ^:private redo-list (atom []))   ;; a list of future states, caused by undoing

 (defn clear-history!


Try to avoid allocating new array in notify-deref-watcher

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -21,6 +21,9 @@

 (defn capture-derefed [f obj]
   (set! (.-cljsCaptured obj) nil)
+  ;; (if-not (nil? (.-watching obj))
+  ;;   (set! (.-reaPos obj) 0))
+  (set! (.-reaPos obj) -1)
   (when (dev?)
     (set! (.-ratomGeneration obj)
           (set! generation (inc generation))))
@@ -28,18 +31,40 @@
     (f)))

 (defn captured [obj]
-  (when-not (nil? (.-cljsCaptured obj))
+  (when-not (and (== -1 (.-reaPos obj))
+                 (nil? (.-cljsCaptured obj)))
     obj))

 (defn- -captured [obj]
   (let [c (.-cljsCaptured obj)]
     (set! (.-cljsCaptured obj) nil)
-    c))
+    (if (nil? c)
+      (when (== (inc (.-reaPos obj))
+                (some-> (.-watching obj) alength))
+        (.-watching obj))
+      c)))
+
+(defn- add-item [a x]
+  (when (== -1 (.indexOf a x))
+    (.push a x)))

 (defn- notify-deref-watcher! [derefable]
   (when-some [obj *ratom-context*]
     (let [c (.-cljsCaptured obj)]
       (if (nil? c)
+        ;; Try to avoid allocating new array
+        (let [p (inc (.-reaPos obj))
+              w (.-watching obj)]
+          (if (and (not (nil? w))
+                   (identical? derefable (aget w p)))
+            (set! (.-reaPos obj) p)
+            (set! (.-cljsCaptured obj)
+                  (if (nil? w)
+                    (array derefable)
+                    (doto (.slice w 0 p)
+                      (add-item derefable))))))
+        (add-item c derefable))
+      #_(if (nil? c)
         (set! (.-cljsCaptured obj) (array derefable))
         (when (== -1 (.indexOf c derefable))
           (.push c derefable)))))


Minor refactoring

Minor refactoring

--- src/tttclj/render.cljs
+++ src/tttclj/render.cljs
@@ -10,7 +10,7 @@

 (q/defcomponent Turn
   "Renders a component saying whose turn it is"
-  [player]
+  [game]
   (d/p {} (str "It is " player "'s turn:")))

 (q/defcomponent Cell
@@ -36,7 +36,7 @@
   "Renders a TicTacToe game"
   [game]
   (d/div {}
-         (Turn (:player game))
+         (Turn game)
          (Grid (:tiles game))))

 (q/render (Game state)


Update strain/strain_test.clj

Update strain/strain_test.clj

Remove `(run-tests)` per recent testing overhaul and reverse my bad
advice re: `constantly`. Thanks, @cayennes!

See PR #73

--- strain/strain_test.clj
+++ strain/strain_test.clj
@@ -33,10 +33,8 @@
   (is (= [0 2 4] (discard odd? (range 6)))))

 (deftest does-not-use-existing-implementations
-  (with-redefs [filter (constantly (throw (Exception. "Implement without filter!")))
-                remove (constantly (throw (Exception. "Implement without remove!")))
-                filterv (constantly (throw (Exception. "Implement without filterv!")))]
+  (with-redefs [filter  (fn [& _] (throw (Exception. "Implement without filter!")))
+                remove  (fn [& _] (throw (Exception. "Implement without remove!")))
+                filterv (fn [& _] (throw (Exception. "Implement without filterv!")))]
     (dorun (retain even? (range 10)))
     (dorun (discard even? (range 10)))))
-
-(run-tests)


Reformat day8.re-frame-10x ns

Reformat day8.re-frame-10x ns

--- src/day8/re_frame_10x.cljs
+++ src/day8/re_frame_10x.cljs
@@ -76,8 +76,8 @@
 (defonce do-after-render-trace-scheduled? (atom false))

 (defn monkey-patch-reagent []
-  (let [#_#_real-renderer reagent.impl.component/do-render
-        ]
+  (let [#_#_real-renderer reagent.impl.component/do-render]
+

     #_(set! reagent.impl.component/do-render
@@ -126,9 +126,9 @@
                                                 (f)
                                                 (trace/with-trace {:op-type :raf-end})
                                                 (when (false? (.-scheduled? reagent.impl.batching/render-queue))
-                                                  (trace/with-trace {:op-type :reagent/quiescent}))
-
-                                                )))))
+                                                  (trace/with-trace {:op-type :reagent/quiescent})))))))
+
+

     #_(set! reagent.impl.batching/schedule
             (fn []
@@ -215,16 +215,16 @@
                                             :left     "0px"
                                             :z-index  99999999}
                                     :child [rc/h-box
-                                            :class    "panel"
-                                            :width    (str (* 100 @panel-width%) "%")
-                                            :height   "100%"
-                                            :style    {:position   "fixed"
-                                                       :z-index    1
-                                                       :box-shadow "rgba(0, 0, 0, 0.3) 0px 0px 4px"
-                                                       :background "white"
-                                                       :left       left
-                                                       :top        "0px"
-                                                       :transition transition}
+                                            :class "panel"
+                                            :width (str (* 100 @panel-width%) "%")
+                                            :height "100%"
+                                            :style {:position   "fixed"
+                                                    :z-index    1
+                                                    :box-shadow "rgba(0, 0, 0, 0.3) 0px 0px 4px"
+                                                    :background "white"
+                                                    :left       left
+                                                    :top        "0px"
+                                                    :transition transition}
                                             :children [[:div.panel-resizer (when @showing? {:style         (resizer-style draggable-area)
                                                                                :on-mouse-down #(reset! dragging? true)})]
                                                        [container/devtools-inner opts]]]]))})))


Implementing basket store very simply

Implementing basket store very simply

--- src/eatme/basket_store.clj
+++ src/eatme/basket_store.clj
@@ -3,66 +3,37 @@
             [cheshire.generate]
             [monger.core :as m]
             [monger.collection :as mc]
-            [monger.joda-time])
+            [monger.joda-time]
+            [monger.operators :refer :all])
   (:import [org.bson.types ObjectId]
            [com.mongodb DB WriteConcern]))

-(defn init
+(defn init!
   "Connect to Mongo"
   []
   (m/connect-via-uri! (config :MONGOLAB_URI))
   (m/set-db! (m/get-db))) ;; db name is in the uri

-(defn- replace-id [id basket]
-  (assoc (dissoc basket :id) :_id id))
-
-(defn save-basket [basket]
-  (let [id (if-let [id (:id basket)] (ObjectId. id) (ObjectId.))]
-    (mc/update "basket" {:_id id} (replace-id id basket) :upsert true)
-    {:id (str id)}))
-
-(defn- replace-_id [basket]
-  (let [id (str (:_id basket))]
-    (assoc (dissoc basket :_id) :id id)))
-
 (defn load-basket [id]
-  (replace-_id (mc/find-map-by-id "basket" (ObjectId. id))))
+  (let [basket-id (ObjectId. id)]
+    (assoc (mc/find-map-by-id "basket" basket-id)
+      :items (mc/find-maps "items" {:_basket basket-id}))))

 (defn user-baskets [owner]
-  (reverse (sort-by :timestamp
-                    (map replace-_id (mc/find-maps "basket" {:owner owner})))))
+  (reverse (sort-by :timestamp (mc/find-maps "basket" {:owner owner}))))

-(defn get-state [a b]
-  (if (not= (:state a) (:state b))
-    "conflict"
-    (:state a)))
+(defn basket-exists? [id]
+  (nil? (load-basket id)))

-(defn normalise-basket [{:keys [items] :as basket}]
-  (assoc basket :items
-         (for [item-group (vals (group-by :item-name items))]
-           (reduce (fn [o n]
-                     (assoc o :qty (+ (:qty o) (:qty n))
-                            :state (get-state o n)))
-                   (first item-group) (rest item-group)))))
+(defn create-basket! []
+  (let [id (ObjectId.)]
+    (mc/insert "basket" {:_id id})
+    (str id)))

-(def states {"list" 0
-             "basket" 1
-             "conflict" 2})
+(defn add-item! [basket-id item]
+  (let [id (ObjectId. basket-id)]
+    (mc/insert "items" (merge {:_id id :_basket (ObjectId. basket-id)} item))
+    (str id)))

-(defn greater-state [a b]
-  (condp some [(:state a) (:state b)]
-    #(= "conflict" %) "conflict"
-    #(= "basket" %) "basket"
-    "list"))
-
-(defn merge-baskets [a b]
-  (let [all-a-items (group-by :item-name (:items (normalise-basket a)))
-        all-b-items (group-by :item-name (:items (normalise-basket b)))]
-    {:items
-     (for [item-name (keys all-a-items)
-           :let [a-items (get all-a-items item-name)
-                 b-items (get all-b-items item-name)]]
-       (cond
-        (every? #(= (:qty (first a-items)) (:qty %)) (concat (rest a-items) b-items))
-        (reduce (fn [o n] (assoc o :state (greater-state o n)))
-                (first a-items) (concat (rest a-items) b-items))))}))
+(defn delete-basket! [id]
+  (mc/remove "basket" {:_id (ObjectId. id)}))


1.3-ifying examples.factorial

1.3-ifying examples.factorial

--- src/examples/factorial.clj
+++ src/examples/factorial.clj
@@ -3,8 +3,8 @@
 ;; Lee Spector, lspector@hampshire.edu, 2010

 (ns examples.factorial
-  (:require [clojush] [clojure.contrib.math])
-  (:use [clojush] [clojure.contrib.math]))
+  (:use [clojush]
+	[clojure.math.numeric-tower]))

 ;;;;;;;;;;;;
 ;; Integer symbolic regression of factorial, using an input instruction and


wip: transform functions

wip: transform functions

--- src/graphql_clj/parser.clj
+++ src/graphql_clj/parser.clj
@@ -8,18 +8,38 @@

 (defn parse
   [stmt]
+  (println stmt)
   (let [parser (insta/parser (io/resource "graphql.bnf"))]
     (parser stmt)))

 (defn transformer
   [parse-tree]
   (insta/transform
-   {:Document (fn [& args] (into {} args))
-    :Definition (fn [definition]
-                  definition)
-    :OperationDefinition (fn [& args]
+   {:Document (fn document [& args]
+                (println args)
+                (into {} args))
+    ;; :Definition (fn definition [definition]
+    ;;               (println definition)
+    ;;               definition)
+    :OperationDefinition (fn operation-definition [& args]
                            (into {} args))
-    :Name (fn [name] [:name name])}
+    :SelectionSet (fn selection-set [& args]
+                    (into {} args))
+    :Selection (fn selection [& args]
+                 (println args)
+                 (into {} args))
+    :Field (fn field [& args]
+             (println args)
+             (into {} args))
+    :Arguments (fn arguments [& args]
+                 (println args)
+                 {:arguments args})
+    :Argument (fn argument [& args]
+                (println args)
+                (into {} args))
+    :Name (fn name [name] [:name name])
+    :FloatValue (fn float-value [v] (Double. v))
+    :IntValue (fn int-value [v] (Integer/parseInt v))}
    parse-tree))

 (def statements
@@ -28,7 +48,7 @@
   user(id: 4) {
     id
     name
-    profilePic(width: 100, height: 50)
+    profilePic(width: 100, height: 50.0)
   }
 }
 "


Fixed issue #3. Partial fix for issue #2 (module-context.xml not being updates however).

--- src/leiningen/amp/impl.clj
+++ src/leiningen/amp/impl.clj
@@ -150,3 +150,4 @@
 (defn deploy-amp!
   [project args]
   (comment "####TODO: NOT YET IMPLEMENTED"))
+


CMR-5906: Updated collection search test.

--- system-int-test/test/cmr/system_int_test/search/collection_spatial_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_spatial_search_test.clj
@@ -434,9 +434,9 @@
         ["0,89,1000000"] [whole-world north-pole on-np touches-np very-tall-cart along-am-line]

         ;; cross antimeridian
-        ["179.8,41,100000"] [whole-world across-am-poly]
-        ["-179.9,22,100000"] [whole-world am-point]
-
+        ["179.8,41,100000"] [whole-world across-am-poly along-am-line]
+        ["-179.9,22,100000"] [whole-world am-point along-am-line]
+
         ;; multiple circles are ANDed together
         ["0,89,100" "0,89,1000000"] [whole-world on-np]
         ["0,0,1000" "0,89,1000" "0,89,1000000"] [whole-world]))


Add fn to get history db

Add fn to get history db

--- src/datemo/db.clj
+++ src/datemo/db.clj
@@ -69,6 +69,9 @@
 (defn db-now []
   (d/db (:conn @db-atom)))

+(defn hist-db-now []
+  (d/db (:conn @db-atom)))
+
 (defn install-schema
   "Attempts to transact a schema. If sucessful, returns tx promise;
    otherwise, error."


fix cljs.js/analyze-deps recursive call, pass analysis environment to analyze-deps from ns-side-effects

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -132,7 +132,8 @@
   "Given a lib, a namespace, deps, its dependencies, env, an analysis environment
    and opts, compiler options - analyze all of the dependencies. Required to
    correctly analyze usage of other namespaces."
-  ([bound-vars ana-env lib deps cb] (analyze-deps bound-vars lib deps nil cb))
+  ([bound-vars ana-env lib deps cb]
+   (analyze-deps bound-vars ana-env lib deps nil cb))
   ([bound-vars ana-env lib deps opts cb]
    (let [compiler @(:*compiler* bound-vars)]
      (binding [ana/*cljs-dep-set* (vary-meta (conj (:*cljs-dep-set* bound-vars) lib)
@@ -210,7 +211,7 @@
              check-uses-and-load-macros)

            (and (not load) (:*analyze-deps* bound-vars) (seq deps))
-           (analyze-deps bound-vars name deps (dissoc opts :macros-ns)
+           (analyze-deps bound-vars ana-env deps (dissoc opts :macros-ns)
              check-uses-and-load-macros)

            :else


Correctly typehint the Random instance

Correctly typehint the Random instance

Thanks, clgv!

--- src/caesium/randombytes.clj
+++ src/caesium/randombytes.clj
@@ -1,7 +1,7 @@
 (ns caesium.randombytes
   (:import (org.abstractj.kalium.crypto Random)))

-(def ^:private random (new Random))
+(def ^:private ^Random random (new Random))

 (defn randombytes
   [n]


about page added

about page added

--- src/cljs/foosball/main.cljs
+++ src/cljs/foosball/main.cljs
@@ -64,6 +64,11 @@
   (when-not (@app :players)
     (go-update-data "/api/players" app :players))
   (go-update-data "/api/matches" app :matches)
+  (set-location app (:id v)))
+
+(defmethod handle-new-location :location/about [app v]
+  (om/update! app :software-dependencies nil)
+  (go-update-data "/api/about/software" app :software-dependencies)
   (set-location app (:id v)))

 (defmethod handle-new-location :default [app {:keys [id]}]
@@ -281,6 +286,28 @@
                                              :state {:sort {:column date-column
                                                             :dir    :desc}}}))))

+(defmethod render-location :location/about [{:keys [software-dependencies version]}]
+  [:div.col-lg-8.jumbotron
+   [:h1 "Foosball"]
+   (when version
+     [:p.lead (str "Version " version)])
+    [:p.lead "Copyright © 2014 " [:a {:href "http://about.me/thomaschrstnsn"} "Thomas Christensen"]]
+    [:h2 "Built using"]
+    [:div.col-lg-12
+     [:table.table.table-hover
+      [:thead
+       [:tr
+        [:th.text-right "Software"]
+        [:th "Version"]]]
+      [:tbody
+       (map (fn [{:keys [name url version]}]
+              [:tr
+               [:td.text-right [:a {:href url} name]]
+               [:td version]])
+            software-dependencies)]]]
+    [:h2 "Styled using"]
+    [:p.lead [:a {:href "http://getbootstrap.com"} "Bootstrap 3"] " with " [:a {:href "http://glyphicons.com"} "Glyphicons"] "."]])
+
 (defmethod render-location :default [{:keys [current-location]}]
   (list
    [:h1 (str current-location)]


Fix part 2 :wrench:

Fix part 2 :wrench:

--- src/metabase/api/embed.clj
+++ src/metabase/api/embed.clj
@@ -110,8 +110,9 @@
   (let [params-to-remove (into #{} (concat (for [[param status] embedding-params
                                                  :when          (not= status "enabled")]
                                              param)
-                                           (for [{param :slug} (:parameters dashboard-or-card)
-                                                 :when         (not (contains? embedding-params param))]
+                                           (for [{slug :slug} (:parameters dashboard-or-card)
+                                                 :let         [param (keyword slug)]
+                                                 :when        (not (contains? embedding-params param))]
                                              param)))]
     (update dashboard-or-card :parameters remove-params-in-set params-to-remove)))


Memo.

Memo.

--- src/loudmoauth/authflow.clj
+++ src/loudmoauth/authflow.clj
@@ -154,7 +154,6 @@
     (request-access-to-data)
     (request-access-and-refresh-tokens)))

-;TODO  - How do we merge back in here?
 (defn init-one
   "Init one provider based on provider name."
   [provider]


update test scene to serialize meshes as byte arrays and additionally export scene as zip

--- examples/test-scene.clj
+++ examples/test-scene.clj
@@ -5,7 +5,8 @@
  '[thi.ng.geom.rect :as r]
  '[thi.ng.geom.polygon :as p]
  '[thi.ng.geom.gmesh :as gm]
- '[thi.ng.common.math.core :as m])
+ '[thi.ng.common.math.core :as m]
+ '[clojure.java.io :as io])

 ;; see LXS syntax ref for description of these entities & options
 ;; http://www.luxrender.net/wiki/Scene_file_format_dev
@@ -13,7 +14,8 @@
 (->
  ;; empty default lux scene
  (lux-scene)
-
+ (configure-meshes-as-byte-arrays)
+
  ;; customize sampler & renderer
  (renderer-sampler)
  (sampler-ld {})
@@ -76,4 +78,6 @@
  ;; the `false` arg means materials, objects and volumes
  ;; are included in the main scene file and not written as separate files
  (serialize-scene "luxor-test" true)
- (export-scene))
+ (export-scene)
+ (export-archived-scene "luxor-test.zip")
+ )


RS + DM #5 - Sign up integration tests

RS + DM #5 - Sign up integration tests

--- integration/d_cent/signup_integration_tests.clj
+++ integration/d_cent/signup_integration_tests.clj
@@ -7,10 +7,12 @@
             [d-cent.integration-helpers :as helpers]
             [d-cent.http-api :as api]))

-(def test-session (helpers/test-context))
+(def test-store (atom {}))
+(def test-session (helpers/test-context test-store))

 (def twitter-callback-url "http://localhost:8080/twitter-callback?oauth_verifier=VERIFICATION_TOKEN")
 (def sign-up-url "http://localhost:8080/sign-up")
+(def protected-resource "http://localhost:8080/objectives/create")

 (defn check-redirects-to
   ([url-fragment]
@@ -23,34 +25,37 @@
 (fact "Users signing in with twitter are redirected to sign-up page"
       (against-background
        (oauth/access-token anything anything anything) => {:user_id "USERID"})
-      (let [response (p/request test-session twitter-callback-url)
-            ;TODO: follow redirect and assert that it contains expected content
-            ]
-        response => (check-redirects-to "/sign-up")))

-(fact "New users signing in via twitter can create user profiles"
+      (p/request test-session twitter-callback-url) => (check-redirects-to "/sign-up"))
+
+(fact "After signing up (by posting their email address) the user is sent back to the resource they were trying to access"
       (against-background
-       (oauth/access-token anything anything anything) => {:user_id "USERID"}
-       (api/create-user-profile {:user-id "twitter-USERID"
-                                 :email-address "test@email.address.com"})
-       => {:_id "SOME_GUID" :user-id "twitter-USERID" :email-address "test@email.address.com"})
-      (let [signed-in-session (p/request test-session twitter-callback-url)
-            response (p/request signed-in-session sign-up-url
-                                :request-method :post
-                                :content-type "application/x-www-form-urlencoded"
-                                :body "email-address=test%40email.address.com")
-            ;TODO: attempt to access protected URI; assert that we get there
-            ]
-        response => (check-redirects-to "/" 303)))
+       (oauth/access-token anything anything anything) => {:user_id "USERID"})

-(fact "Returning users with profiles are authenticated without being requested for email address"
+      (let [unauthorized-request-session (p/request test-session protected-resource)
+            signed-in-session (p/request unauthorized-request-session twitter-callback-url)]
+        (p/request signed-in-session sign-up-url
+                   :request-method :post
+                   :content-type "application/x-www-form-urlencoded"
+                   :body "email-address=test%40email.address.com"))
+      => (check-redirects-to protected-resource 303)
+
+      (provided (api/create-user-profile {:user-id "twitter-USERID"
+                                          :email-address "test@email.address.com"})
+                => {:_id "SOME_GUID"
+                    :user-id "twitter-USERID"
+                    :email-address "test@email.address.com"} :times 1))
+
+(fact "After signing in, a user with an existing profile is immediately sent to the resource they were trying to access"
       (against-background
-       (oauth/access-token anything anything anything) => {:user_id "USERID"}
-       (api/find-user-profile-by-user-id "twitter-USERID") => {:_id "SOME_GUID"
-                                                              :user-id "twitter-USERID"
-                                                              :email-address "test@email.address.com"})
-      (let [signed-in-session (p/request test-session twitter-callback-url)
-            response (p/follow-redirect signed-in-session)
-            ;TODO: attempt to access protected URI; assert that we get there
-            ]
-        response => (check-redirects-to "/" 303)))
+       (oauth/access-token anything anything anything) => {:user_id "USERID"})
+
+      (let [unauthorized-request-session (p/request test-session protected-resource)
+            signed-in-session (p/request unauthorized-request-session twitter-callback-url)]
+        (p/follow-redirect signed-in-session)) => (check-redirects-to protected-resource 303)
+
+        (provided
+         (api/find-user-profile-by-user-id "twitter-USERID")
+         => {:_id "SOME_GUID"
+             :user-id "twitter-USERID"
+             :email-address "test@email.address.com"} :times 1))


make multicamera work when images don't come in expected order

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -276,20 +276,23 @@
         tags (parse-core-metadata md)]
     {:pix pix :tags (dissoc tags "StartTime-ms")}))

+(defn make-multicamera-channel [camera-channel raw-channel-index]
+  (+ camera-channel (* (core getNumberOfCameraChannels) raw-channel-index)))
+
 (defn make-multicamera-events [event]
-  (let [num-camera-channels (long (core getNumberOfCameraChannels))]
+  (let [num-camera-channels (core getNumberOfCameraChannels)]
     (for [camera-channel (range num-camera-channels)]
-      (let [super-channel-index (+ camera-channel (* num-camera-channels (event :channel-index)))]
+      (let [super-channel-index (make-multicamera-channel camera-channel (event :channel-index))]
         (assoc event :channel-index super-channel-index
-                     :camera-channel-index camera-channel)))))
-
+               :camera-channel-index camera-channel)))))
+
 (defn collect-burst-images [event out-queue]
   (when (first-trigger-missing?) (pop-burst-image)) ; drop first image if first trigger doesn't happen
   (swap! state assoc :burst-time-offset nil)
   (let [slices (second @active-slice-sequence)]
-    (dorun
-      (map-indexed
-        (fn [i evt]
+    (doseq [event (:burst-data event)]
+     (doseq [i (range (core getNumberOfCameraChannels))]
+       (println "i=" i)
           (when-not (@state :stop)
             (let [image (pop-burst-image)
                   image+ (if-not slices
@@ -299,19 +302,23 @@
                 (swap! state assoc
                        :burst-time-offset (- (elapsed-time @state)
                                              (core-time-from-tags (image :tags)))))
-              ;(println (image+ :tags))
-              (.put out-queue (make-TaggedImage (annotate-image image+ evt @state
-                                                                (burst-time (:tags image) @state)))))
+              (println (image+ :tags))
+              (let [cam-chan (get-in image [:tags "Dual-Camera-CameraChannelIndex"])
+                    event+ (if cam-chan
+                             (assoc event :channel-index
+                                  (Long/parseLong cam-chan))
+                             event)]
+                (.put out-queue (make-TaggedImage (annotate-image image+ event+ @state
+                                                                (burst-time (:tags image) @state))))))
             (when (core isBufferOverflowed)
               (swap! state assoc :stop true)
-              (ReportingUtils/showError "Circular buffer overflowed."))))
-        (flatten (map make-multicamera-events (event :burst-data))))))
+              (ReportingUtils/showError "Circular buffer overflowed."))))))
   (while (and (not (@state :stop)) (. mmc isSequenceRunning))
     (Thread/sleep 5)))

 (defn collect-snap-image [event out-queue]
   (let [image
-        {:pix (core getImage)
+        {:pix (core getImage (event :channel-index))
          :tags nil}]
     (select-keys event [:position-index :frame-index
                         :slice-index :channel-index])


cleanup

cleanup

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -56,10 +56,6 @@
 (defn random-error [prob]
   (when (< (rand) prob)
     (throw (Exception. "Simulated error"))))
-
-(defmacro time* [expr]
- `(do (println "Timing: " '~expr)
-      (time ~expr)))

 ;; globals

@@ -257,12 +253,12 @@
   (let [z-drive (@state :default-z-drive)
         z0 (get-z-stage-position z-drive)]
   (try
+    (log "running autofocus " (.. gui getAutofocusManager getDevice getDeviceName))
     (let [z (.. gui getAutofocusManager getDevice fullFocus)]
       (swap! state assoc-in [:last-stage-positions (@state :default-z-drive)] z))
     (catch Exception e
-           (ReportingUtils/logError e)
-           (set-stage-position z-drive (+ 1.0e-6 z0)))))
-    (log "running autofocus " (.. gui getAutofocusManager getDevice getDeviceName)))
+           (ReportingUtils/logError e "Autofocus failed.")
+           (set-stage-position z-drive (+ 1.0e-6 z0))))))

 (defn snap-image [open-before close-after]
   (with-core-setting [getAutoShutter setAutoShutter false]
@@ -458,7 +454,7 @@
            [false false])]
     (condp = (:task event)
       :snap (apply snap-image shutter-states)
-      :burst (init-burst (:burst-length event)
+      :burst (init-burst (count (:burst-data event))
                          (:trigger-sequence event)
                          (:relative-z event))
       nil)))
@@ -577,7 +573,7 @@
                          (or (:autofocus event)
                              (when-let [t (:wait-time-ms event)]
                                (pos? t))))]
-    (filter identity ;; removes nil events
+    (filter identity
       (flatten
         (list
           #(log event)
@@ -619,7 +615,7 @@
 (defn run-acquisition [this settings out-queue]
   (try
     (def acq-settings settings)
-    (log "Starting MD Acquisition: " settings)
+    (log (str "Starting MD Acquisition: " settings))
     (prepare-state this)
     (binding [state (.state this)]
       (def last-state state) ; for debugging
@@ -707,7 +703,7 @@
       "ComputerName" (.. InetAddress getLocalHost getHostName)
       "Depth" (core getBytesPerPixel)
       "Directory" (if (:save settings) (settings :root) "")
-      "Frames" (:numFrames settings)
+      "Frames" (count (:frames settings))
       "GridColumn" 0
       "GridRow" 0
       "Height" (core getImageHeight)


treatment-times allows starting time range

--- src/test_utils/sandbox.cljs
+++ src/test_utils/sandbox.cljs
@@ -126,22 +126,24 @@
                stop-duration-s]]
      [start stop])))

-    (defn treatment-times []
-    (let [[start-0 stop-0] (typical-treatment-time-range)
-            next-fn (fn [[start-n-1 stop-n-1]]
-                    (typical-treatment-time-range start-n-1 stop-n-1))]
-        (iterate next-fn [start-0 stop-0])))
-
-    (defn typical-stage-separation []
-    (tuc/draw-normal 45 3))
-
-    (defn stage-extents []
-    (let [extent-0 (typical-stage-extent)
-            next-fn (fn [[top-n-1 bottom-n-1] extent-0]
-                    (let [bottom (- top-n-1 (typical-stage-separation))
-                            top (- bottom (typical-stage-length))]
-                        [top bottom]))]
-        (iterate next-fn extent-0)))
+(defn treatment-times
+  ([] (treatment-times (typical-treatment-time-range)))
+  ([start-treatment-time-range]
+   (let [[start-0 stop-0] start-treatment-time-range
+         next-fn (fn [[start-n-1 stop-n-1]]
+                   (typical-treatment-time-range start-n-1 stop-n-1))]
+     (iterate next-fn [start-0 stop-0]))))
+
+(defn typical-stage-separation []
+  (tuc/draw-normal 45 3))
+
+(defn stage-extents []
+  (let [extent-0 (typical-stage-extent)
+        next-fn (fn [[top-n-1 bottom-n-1] extent-0]
+                  (let [bottom (- top-n-1 (typical-stage-separation))
+                        top (- bottom (typical-stage-length))]
+                    [top bottom]))]
+    (iterate next-fn extent-0)))

 (defn typical-interwell-distance [plot-angle]
   (let [euclidean-distance (tuc/draw-normal 874 37)


Revert changing require alias

Revert changing require alias

--- src/braid/server/db/user.clj
+++ src/braid/server/db/user.clj
@@ -2,7 +2,7 @@
   (:require [datomic.api :as d]
             [clojure.edn :as edn]
             [clojure.string :as string]
-            [crypto.password.scrypt :as scrypt]
+            [crypto.password.scrypt :as password]
             [braid.server.db :as db]
             [braid.server.db.common :refer :all]
             [braid.server.quests.db :refer [activate-first-quests-txn]]))
@@ -165,7 +165,7 @@

 (defn set-user-password-txn
   [user-id password]
-  [[:db/add [:user/id user-id] :user/password-token (scrypt/encrypt password)]])
+  [[:db/add [:user/id user-id] :user/password-token (password/encrypt password)]])

 (defn user-set-preference-txn
   "Set a key to a value for the user's preferences."


client tranformation moved to separate ->map function

--- src/cerber/stores/client.clj
+++ src/cerber/stores/client.clj
@@ -11,14 +11,14 @@
             [cerber.stores.token :as token]
             [cerber.helpers :as helpers]))

-(declare init-clients)
+(declare ->map init-clients)

 (defrecord Client [id secret info redirects grants scopes])

 (defrecord SqlClientStore []
   Store
   (fetch-one [this [client-id]]
-    (first (db/find-client {:id client-id})))
+    (->map (first (db/find-client {:id client-id}))))
   (revoke-one! [this [client-id]]
     (db/delete-client {:id client-id}))
   (store! [this k client]
@@ -99,15 +99,9 @@
       (first result))))

 (defn find-client [client-id]
-  (if-let [found (fetch-one *client-store* [client-id])]
+  (if-let [found (and client-id (fetch-one *client-store* [client-id]))]
     (let [{:keys [approved scopes grants redirects]} found]
-      (map->Client
-       (-> found
-           (dissoc :approved)
-           (assoc  :approved? approved
-                   :scopes (str->array scopes)
-                   :grants (str->array grants)
-                   :redirects (str->array redirects)))))))
+      (map->Client found))))

 (defn purge-clients
   []
@@ -139,3 +133,12 @@

 (defn redirect-uri-valid? [client redirect-uri]
   (.contains (:redirects client) redirect-uri))
+
+(defn ->map [result]
+  (when-let [{:keys [approved scopes grants redirects]} result]
+    (-> result
+        (assoc  :approved? approved
+                :scopes (str->array scopes)
+                :grants (str->array grants)
+                :redirects (str->array redirects))
+        (dissoc :approved))))


Fix 1 segment exception.

Fix 1 segment exception.

--- src/clj/triangulate/core.clj
+++ src/clj/triangulate/core.clj
@@ -73,14 +73,16 @@
         pairs (partition 2 1 coordinates)
         segments (map (fn [[a b]] (haversine a b)) pairs)
         back-segment (take-segments segments gap)
-        front-segment (dec back-segment)
+        front-segment (max (dec back-segment) 0)
         back-distance (reduce + (take back-segment segments))
         front-distance (reduce + (take front-segment segments))
         back-coordinate (nth coordinates back-segment)
         front-coordinate (nth coordinates front-segment)
         front-to-back (- back-distance front-distance)
         front-to-target (- gap front-distance)]
-    (interpolate-coordinates front-coordinate back-coordinate front-to-back front-to-target)))
+    (if (zero? back-segment)
+      back-coordinate
+      (interpolate-coordinates front-coordinate back-coordinate front-to-back front-to-target))))

 (defroutes routes
   (POST "/rush-hour/api/triangulate/edn" {:keys [body]}


Back to entities button

Back to entities button

--- src/clj_money/web/grants.clj
+++ src/clj_money/web/grants.clj
@@ -39,8 +39,14 @@
           [:th "Email"]]
          (map grant-row grants)]
         [:a.btn.btn-primary
-         {:href (format "/entities/%s/grants/new" (:id entity))}
-         "Add"]]])))
+         {:href (format "/entities/%s/grants/new" (:id entity))
+          :title "Click here to grant a user access to this entity."}
+         "Add"]
+        " "
+        [:a.btn.btn-default
+         {:href "/entities"
+          :title "Click here to return to the list of entities."}
+         "Back"]]])))

 (defn- permission-key
   [resource-type action]


Change display hand to use map-indexed.

Change display hand to use map-indexed.

--- src/cljs-blackjack/core.cljs
+++ src/cljs-blackjack/core.cljs
@@ -16,9 +16,6 @@
                      :playing false
                      :player-feedback ""
                      :dealer-feedback ""}))
-
-(def cardnames ["ace", "2", "3", "4", "5", "6", "7", "8", "9" "10" "J" "Q" "K"])
-(def suits ["clubs" "diamonds" "hearts" "spades"])

 (defn deal
   "Deal one card from the deck to a hand in the given
@@ -48,15 +45,6 @@
                      ace-value
                      (min 10 card-mod))]
     [(+ acc card-value) (if (= card-mod 1) 1 ace-value)]))
-
-(defn english
-  "Given a card value and position (:up or :down),
-  return a string giving the card name."
-  [[cval pos]]
-  (if (= pos :up)
-    (str (nth cardnames (rem cval 13)) " of "
-         (nth suits (quot cval 13)))
-    "face down card"))

 (defn evaluate-hand
   "Get total value of hand. Return a vector with total and
@@ -187,15 +175,24 @@
   [event]
   (swap! game assoc :current-bet 10 :player-money 1000))

+(def cardnames ["ace", "2", "3", "4", "5", "6", "7", "8", "9" "10" "J" "Q" "K"])
+(def suits ["clubs" "diamonds" "hearts" "spades"])
+
+(defn english
+  "Given a card value and position (:up or :down),
+  return a string giving the card name."
+  [[cval pos]]
+  (if (= pos :up)
+    (str (nth cardnames (rem cval 13)) " of "
+         (nth suits (quot cval 13)))
+    "face down card"))
+
 (defn card-image
   "Display card number N from the given hand. Assign the
   alt and title attributes of the image, and use relative
   positioning to overlap the cards."
-  [hand n]
-  (let [[card pos :as wholecard] (if (< n (count hand))
-                                   (nth hand n)
-                                   [-1 :up])
-        filename (if (< card 0) "outline" (if (= pos :up) card "blue_grid_back"))]
+  [n [card pos :as wholecard]]
+  (let [filename (if (= pos :up) card "blue_grid_back")]
     [:img {:src (str "./images/" filename ".svg")
            :alt (english wholecard)
            :title (english wholecard)
@@ -208,7 +205,7 @@
   "Show all the cards in a hand."
   [hand]
   (into [] (concat [:div {:class "cards"}]
-                   (map (fn [x] (card-image hand x)) (range 0 (count hand))))))
+                   (map-indexed card-image hand))))

 (defn tableau
   "Display the playing area (the tableau)."


Print full keyword for operation name

Print full keyword for operation name

--- src/day8/re_frame/trace.cljs
+++ src/day8/re_frame/trace.cljs
@@ -178,7 +178,7 @@
                                   [:span.op-string {:on-click (fn [ev]
                                                                 (add-filter filter-items (name op-name) :contains)
                                                                 (.stopPropagation ev))}
-                                    op-name]]
+                                    (str op-name)]]
                              [:td.trace--meta
                               (.toFixed duration 1) " ms"]]
                             (when show-row?


Fix `runner/stop!` runaway loop death; tailing writes still failing

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -324,26 +324,27 @@
       ;; ensuring that we don't have race conditions for conv state. The state kept in the atom is basically
       ;; just a convenience.
       (go-loop [conv conv]
-        (let [first-msg (<! message-chan)
-              retry-msgs (async/poll! retry-chan)
-              _ (log/info "Message chan put in queue-message-batch! for zid:" zid)
-              msgs (vec (concat retry-msgs [first-msg] (take-all! message-chan)))
-              {:as split-msgs :keys [votes moderation]} (split-batches msgs)
-              error-handler (build-update-error-handler conv-man retry-chan conv)
-              _ (log/info "About to run updaters")
-              ;; TODO Oh... is this how we're failing to get moderation affecting repness? We're presently only updating mongo
-              ;; (via `update`) if there are also votes. (see below)
-              conv (if moderation
-                     (conv/mod-update conv moderation)
-                     conv)
-              ;; Should extracct the stateful bits here till the very end, so even if there are just mods it updates
-              conv (if votes
-                     (update conv-man conv votes error-handler)
-                     conv)]
-          (log/info "Completed computing conversation zid:" zid)
-          (swap! conversations assoc-in [zid :conv] conv)
-          (doseq [[k f] @listeners] (try (f conv) (catch Exception e (log/error "Listener error") (.printStackTrace e))))
-          (recur conv))))))
+        ;; If nil comes through as the first message, then the chan is closed, and we should be done, not continue looping forever
+        (when-let [first-msg (<! message-chan)]
+          (let [retry-msgs (async/poll! retry-chan)
+                _ (log/info "Message chan put in queue-message-batch! for zid:" zid)
+                msgs (vec (concat retry-msgs [first-msg] (take-all! message-chan)))
+                {:as split-msgs :keys [votes moderation]} (split-batches msgs)
+                error-handler (build-update-error-handler conv-man retry-chan conv)
+                _ (log/info "About to run updaters")
+                ;; TODO Oh... is this how we're failing to get moderation affecting repness? We're presently only updating mongo
+                ;; (via `update`) if there are also votes. (see below)
+                conv (if moderation
+                       (conv/mod-update conv moderation)
+                       conv)
+                ;; Should extracct the stateful bits here till the very end, so even if there are just mods it updates
+                conv (if votes
+                       (update conv-man conv votes error-handler)
+                       conv)]
+            (log/info "Completed computing conversation zid:" zid)
+            (swap! conversations assoc-in [zid :conv] conv)
+            (doseq [[k f] @listeners] (try (f conv) (catch Exception e (log/error "Listener error") (.printStackTrace e))))
+            (recur conv)))))))

 ;; Need to find a good way of making sure these tests don't ever get committed uncommented


Improved profile statistics for mongo

Improved profile statistics for mongo

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -133,7 +133,7 @@

 (defn handle-profile-data
   "For now, just log profile data. Eventually want to send to influxDB and graphite."
-  [conv]
+  [conv & {:keys [recompute n-votes] :as extra-data}]
   (if-let [prof-atom (:profile-data conv)]
     (let [prof @prof-atom
           tot (apply + (map second prof))
@@ -141,6 +141,9 @@
       (try
         (->> prof
              (format-for-mongo identity)
+             (assoc :n-ptps (:n conv))
+             (merge (hash-map-subset #{:n-cmts :zid})
+                    extra-data)
              (mongo-upsert-results (db/mongo-collection-name "profile")))
         (catch Exception e
           (log/error "Unalbe to submit profile data for zid:" (:zid conv))))
@@ -157,7 +160,7 @@
             zid            (:zid updated-conv)
             finish-time    (System/currentTimeMillis)]
         (log/info "Finished computng conv-update for zid" zid "in" (- finish-time start-time) "ms")
-        (handle-profile-data updated-conv)
+        (handle-profile-data updated-conv :n-votes (count votes))
         ; Format and upload main results
         (doseq [[col-name prep-fn] [["main" prep-main] ; main math results, for client
                                     ["bidtopid" prep-bidToPid]]] ; bidtopid mapping, for server


Deflake k8s s3 logs test for live logs (#552)

--- waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
+++ waiter/integration/waiter/kubernetes_scheduler_integration_test.clj
@@ -56,6 +56,27 @@
         (with-service-cleanup
           service-id
           (assert-service-on-all-routers waiter-url service-id cookies)
+
+          ;; Test that the active instances' logs are available.
+          ;; This portion of the test logic was copied from basic-test/test-basic-logs
+          (let [active-instances (get-in (service-settings waiter-url service-id :cookies cookies)
+                                         [:instances :active-instances])
+                log-url (:log-url (first active-instances))
+                _ (log/debug "Log Url Active:" log-url)
+                make-request-fn (fn [url] (make-request url "" :verbose true))
+                {:keys [body] :as logs-response} (make-request-fn log-url)
+                _ (assert-response-status logs-response 200)
+                _ (log/debug "Response body:" body)
+                log-files-list (walk/keywordize-keys (json/read-str body))
+                stdout-file-link (:url (first (filter #(= (:name %) "stdout") log-files-list)))
+                stderr-file-link (:url (first (filter #(= (:name %) "stderr") log-files-list)))]
+            (is (every? #(string/includes? body %) ["stderr" "stdout"])
+                (str "Live directory listing is missing entries: stderr and stdout, got response: " logs-response))
+            (doseq [file-link [stderr-file-link stdout-file-link]]
+              (if (string/starts-with? (str file-link) "http")
+                (assert-response-status (make-request-fn file-link) 200)
+                (log/warn "test-basic-logs did not verify file link:" stdout-file-link))))
+
           ;; Get a service with at least one active and one killed instance.
           ;; This portion of the test logic was copied from basic-test/test-killed-instances
           (log/info "starting parallel requests")
@@ -77,26 +98,6 @@
                               seq)
                         :interval 2 :timeout 45)
               (str "No killed instances found for " service-id))
-
-          ;; Test that the active instances' logs are available.
-          ;; This portion of the test logic was copied from basic-test/test-basic-logs
-          (let [active-instances (get-in (service-settings waiter-url service-id :cookies cookies)
-                                         [:instances :active-instances])
-                log-url (:log-url (first active-instances))
-                _ (log/debug "Log Url Active:" log-url)
-                make-request-fn (fn [url] (make-request url "" :verbose true))
-                {:keys [body] :as logs-response} (make-request-fn log-url)
-                _ (assert-response-status logs-response 200)
-                _ (log/debug "Response body:" body)
-                log-files-list (walk/keywordize-keys (json/read-str body))
-                stdout-file-link (:url (first (filter #(= (:name %) "stdout") log-files-list)))
-                stderr-file-link (:url (first (filter #(= (:name %) "stderr") log-files-list)))]
-            (is (every? #(string/includes? body %) ["stderr" "stdout"])
-                (str "Directory listing is missing entries: stderr and stdout, got response: " logs-response))
-            (doseq [file-link [stderr-file-link stdout-file-link]]
-              (if (string/starts-with? (str file-link) "http")
-                (assert-response-status (make-request-fn file-link) 200)
-                (log/warn "test-basic-logs did not verify file link:" stdout-file-link))))

           ;; Test that the killed instances' logs were persisted to S3.
           ;; This portion of the test logic was modified from the active-instances tests above.
@@ -122,7 +123,7 @@
             (is (wait-for
                   #(every? (partial string/includes? body) ["stderr" "stdout"])
                   :interval 1 :timeout 30)
-                (str "Directory listing is missing entries: stderr and stdout, got response: " logs-response))
+                (str "Killed directory listing is missing entries: stderr and stdout, got response: " logs-response))
             (doseq [file-link [stderr-file-link stdout-file-link]]
               (if (string/starts-with? (str file-link) "http")
                 (assert-response-status (make-request-fn file-link) 200)


Make should-component-update a little faster for :style attrs

--- src/reagent/impl/util.cljs
+++ src/reagent/impl/util.cljs
@@ -56,12 +56,12 @@
            (reduce-kv (fn [res k v]
                         (let [yv (get y k -not-found)]
                           (if (or (keyword-identical? v yv)
-                                  ;; hack to allow reagent.core/partial and :style
-                                  ;; maps to be compared with =
-                                  (and (or
-                                        (keyword-identical? k :style)
-                                        (identical? (type v) partial-ifn))
-                                       (= v yv)))
+                                  ;; Allow :style maps and reagent/partial
+                                  ;; and :style maps to be compared properly
+                                  (and (keyword-identical? k :style)
+                                       (shallow-equal-maps v yv))
+                                  (and (identical? (type v) partial-ifn)
+                                       (= y yv)))
                             res
                             (reduced false))))
                       true x))))


add a version key to workspace-table local storage (#736)

--- src/cljs/main/broadfcui/page/workspaces_list.cljs
+++ src/cljs/main/broadfcui/page/workspaces_list.cljs
@@ -151,7 +151,7 @@
                                 [:hr {:style {:size "1px" :noshade true}}]
                                 (map checkbox realm-types)])}]))
         [table/Table
-         {:state-key "workspace-table"
+         {:state-key "workspace-table" :v 1
           :empty-message "No workspaces to display." :retain-header-on-empty? true
           :cell-padding-left nil
           :initial-rows-per-page 10


remove fog meta weight

remove fog meta weight

--- src/cljs/wombats_web_client/components/arena.cljs
+++ src/cljs/wombats_web_client/components/arena.cljs
@@ -74,7 +74,6 @@
     :shot      1
     :explosion 2
     :smoke     3
-    :fog       3
     0))

 (defn- sort-meta


CMR-5081: Fix typos.

CMR-5081: Fix typos.

--- collection-renderer-lib/src/cmr/collection_renderer/services/collection_renderer.clj
+++ collection-renderer-lib/src/cmr/collection_renderer/services/collection_renderer.clj
@@ -134,7 +134,7 @@
     collection
     concept-id
     (get-additional-information context concept-id)))
-  ([context collection concept-id additional_information]
+  ([context collection concept-id additional-information]
    (let [umm-json (umm-json/umm->json
                    (vm/migrate-umm context
                                    :collection
@@ -148,4 +148,4 @@
                  "relative_root_url" (context->relative-root-url context)
                  "edsc_url" (search-edsc-url)
                  "concept_id" concept-id
-                 "additional_information" additional_information}))))
+                 "additional_information" additional-information}))))


Determining svg-size for the map.  add-pos, sub-pos, mul-pos helpers

--- src/glory_of_empires/map.clj
+++ src/glory_of_empires/map.clj
@@ -21,20 +21,23 @@

 (defn distance [dx dy] (Math/sqrt (+ (* dx dx) (* dy dy))))

+(defn add-pos [ { x1 :x y1 :y } { x2 :x y2 :y } ] { :x (+ x1 x2) :y (+ y1 y2) } )
+(defn sub-pos [ { x1 :x y1 :y } { x2 :x y2 :y } ] { :x (- x1 x2) :y (- y1 y2) } )
+(defn mul-pos [ { x :x y :y } m ] { :x (* x m) :y (* y m) } )
+
 ; -------------------------- map ---------------------------------

-(def tile-height 376)
-(def tile-width 432)
+(def tile-size { :x 432 :y 376 } )

 (defn- screen-pos
   { :test (fn [] (is (= { :x 0.0 :y 0.0 } (screen-pos { :x 0 :y 0 } )))) }
   [ { logical-x :x logical-y :y } ]
-    { :x (* logical-x tile-width 0.75)
-      :y (* tile-height (+ (* logical-x 0.5) logical-y)) } )
+    { :x (* logical-x (tile-size :x) 0.75)
+      :y (* (tile-size :y) (+ (* logical-x 0.5) logical-y)) } )

 (defn- tile-on-table? [ piece map-size ]
   (let [ { x :x y :y } (screen-pos (:logical-pos piece)) ]
-    (< (distance x y) (* tile-height map-size 1.01 ))))
+    (< (distance x y) (* (tile-size :y) map-size 1.01 ))))

 (defn- random-system [ x y ]
   { :logical-pos { :x x :y y } :system (rand-nth all-systems) } )
@@ -50,33 +53,27 @@

 (defn- piece-to-svg [ { logical-pos :logical-pos system :system :as tile } ]
   (let [ { x :x y :y } (screen-pos logical-pos) ]
-    [ :image { :x (int x) :y (int y) :width tile-width :height tile-height
+    [ :image { :x (int x) :y (int y) :width (tile-size :x) :height (tile-size :y)
                "xlink:href" (str resources-url "Tiles/" (system :image)) } ] ))

-(defn map-to-svg [ map-pieces ]
+(defn map-to-svg [ map-pieces scale ]
   (let [ screen-locs (->> map-pieces (map :logical-pos) (map screen-pos))
-         { min-x :x min-y :y } (min-pos screen-locs)
-         { max-x :x max-y :y } (max-pos screen-locs)
-         counter-translate (str (- min-x) "," (- min-y)) ]
+         min-p (min-pos screen-locs)
+         max-p (max-pos screen-locs)
+         size (mul-pos (add-pos (sub-pos max-p min-p) tile-size) scale)
+         counter-translate (str (- (min-p :x)) "," (- (min-p :y))) ]
     [ :html {}
       [ :body { :style "background: #202020;" }
-        [ :svg { :width 1500, :height 1000, "xmlns:xlink" "http://www.w3.org/1999/xlink" }
-          (concat [ :g { :transform (str "scale(0.5) translate(" counter-translate ")") } ]
+        [ :svg { :width (:x size), :height (:y size), "xmlns:xlink" "http://www.w3.org/1999/xlink" }
+          (concat [ :g { :transform (str "scale(" scale ") translate(" counter-translate ")") } ]
                   (map piece-to-svg map-pieces)) ] ] ] ))

 ;----------------- web server ----------------------
-
-(def big-map (xml-to-text (map-to-svg (make-random-map 4))))

 (defn handler [request]
   (println (pretty-pr request))
   {:status 200
    :headers {"Content-Type" "text/html"}
-   :body (xml-to-text (map-to-svg (make-random-map 3))) } )
+   :body (xml-to-text (map-to-svg (make-random-map 3) 1.0)) } )

-
-(defn -main [& args]
-  (println (xml-to-text (map-to-svg (make-random-map 2))))
-  (spit "map.html" (xml-to-text (map-to-svg (make-random-map 4))))
-  (run-jetty handler {:port 3000})
-)
+(defn -main [& args] (run-jetty handler {:port 3000} ) )


fix issue for not-required field argument

--- src/graphql_clj/executor.clj
+++ src/graphql_clj/executor.clj
@@ -6,17 +6,21 @@
             [instaparse.core :as insta]
             [clojure.set :as set]))

-(defn- update-argument
+(defn- update-arguments-fn
   "Update argument value if argument defined as variable and variable does exist in `variables`."
-  [variables {:keys [argument-name value variable-name]}] ;; TODO: handle case when arguments are defined in field, but no argument provided.
-  (cond
-    value [argument-name value]
-    (and variable-name (contains? variables variable-name)) [argument-name (get variables variable-name)]
-    (and variable-name (not (contains? variables variable-name))) (gerror/throw-error (format "Variable(%s) is missing from input variables." variable-name))
-    :else (gerror/throw-error (format "Argument value is missing for argument (%s) (%s)." argument-name value))))
-
-(defn build-arguments [selection variables]
-  (->> selection :arguments (map (partial update-argument variables)) (into {})))
+  [variables]
+  (fn [result {:keys [argument-name value variable-name] :as argument}]
+    (cond
+      ;; Argument has value
+      (contains? argument value) (assoc result [argument-name value]) ; Do not use value direclty, since argument value could be null
+      ;; Argument has value from variable
+      (and variable-name (contains? variables variable-name)) (assoc result argument-name (get variables variable-name))
+      :default result)))
+
+(defn build-arguments
+  "Build arguments for field, only process provided arguments. Not provided arguments will be taken care by default arguments value after building arguments. About nulltype discussion see https://github.com/facebook/graphql/pull/83."
+  [selection variables]
+  (reduce (update-arguments-fn variables) {} (:arguments selection)))

 (defn get-selection-name
   [selection]


renamed byte-utils/->string to byte-utils/->str

--- src/hbase_clj/byte_utils.clj
+++ src/hbase_clj/byte_utils.clj
@@ -109,7 +109,7 @@
   [b t]
   (Bytes/indexOf b t))

-(defn ->string
+(defn ->str
   ([b]
    (Bytes/toString b))
   ([b offset]


Commented out unused namespaces, added pr.owl-specific namespaces

--- src/kabob/core/namespace.clj
+++ src/kabob/core/namespace.clj
@@ -36,137 +36,139 @@
         ;; be removed once the 'http:/' bug is resolved.
         ;; ---------------------------------------------------------------------------
         ("bnode" "http://ccp.ucdenver.edu/bnode/")
-        ("bird_pr","http://birdgenenames.org/cgnc/")
+        ("cgnc_pr","http://birdgenenames.org/cgnc/")
         ("rgd_pr","http://rgd.mcw.edu/rgdweb/report/gene/")
         ("tair_pr","http://www.arabidopsis.org/servlets/")
         ("hgnc_pr","http://www.genenames.org/cgi-bin/")
-        ("yeast_pr","http://www.yeastgenome.org/cgi-bin/")
+        ("sgd_pr","http://www.yeastgenome.org/cgi-bin/")
         ("flybase_pr","http://flybase.org/reports/")
         ("eco_pr","http://www.ecogene.org/gene/")
         ("pombase_pr","http://www.pombase.org/spombe/result/")
         ("wormbase_pr","http://www.wormbase.org/species/c_elegans/gene/")
         ("zfin_pr","http://zfin.org/action/marker/view/")
+        ("mgi_pr","http://www.informatics.jax.org/marker/")
+        ("ncbi_pr","http://www.ncbi.nlm.nih.gov/")
         ;; ---------------------------------------------------------------------------

-       ("kiao" "http://kabob.ucdenver.edu/iao/")
-       ("kabob" "http://kabob.ucdenver.edu/")
-       ("kbio" "http://kabob.ucdenver.edu/bio/")
-
-       ;;in domain
-       ("bfo" "http://www.ifomis.org/bfo/1.1#")
-       ("iaobfo" "http://kabob.ucdenver.edu/iao/bfo/")
-
-       ;;("bto" "http://purl.org/obo/owl/BTO#")
-       ("iaobto" "http://kabob.ucdenver.edu/iao/bto/")
-
-       ;;("chebi" "http://purl.org/obo/owl/CHEBI#")
-       ("iaochebi" "http://kabob.ucdenver.edu/iao/chebi/")
-
-       ;;("cl" "http://purl.org/obo/owl/CL#")
-       ("iaocl" "http://kabob.ucdenver.edu/iao/cl/")
-
-       ("dip" "http://dip.doe-mbi.ucla.edu/dip/")
-       ("iaodip" "http://kabob.ucdenver.edu/iao/dip/")
-
-       ;;("drugbank" "")
-       ("iaodrugbank" "http://kabob.ucdenver.edu/iao/drugbank/")
-
-       ("ecocyc" "http://ecocyc.org/")
-       ("iaoecocyc" "http://kabob.ucdenver.edu/iao/ecocyc/")
-
-       ("eg" "http://www.ncbi.nlm.nih.gov/gene/")
-       ("iaoeg" "http://kabob.ucdenver.edu/iao/eg/")
-
-       ("embl" "http://www.ebi.ac.uk/embl/")
-       ("iaoembl" "http://kabob.ucdenver.edu/iao/embl/")
-
-       ("gad" "http://geneticassociationdb.nih.gov/")
-       ("iaogad" "http://kabob.ucdenver.edu/iao/gad/")
-
-       ("gensat" "http://gensat.org/")
-       ("iaogensat" "http://kabob.ucdenver.edu/iao/gensat/")
-
-       ;;("go" "http://purl.org/obo/owl/GO#")
-       ("iaogo" "http://kabob.ucdenver.edu/iao/go/")
-
-       ("goa" "http://www.ei.ac.uk/GOA/")
-       ("iaogoa" "http://kabob.ucdenver.edu/iao/goa/")
-
-       ("hgnc" "http://www.genenames.org/hgnc/")
-       ("iaohgnc" "http://kabob.ucdenver.edu/iao/hgnc/")
-
-       ("homologene" "http://www.ncbi.nlm.nih.gov/homologene/")
-       ("iaohomologene" "http://kabob.ucdenver.edu/iao/homologene/")
-
-       ("iaohp" "http://kabob.ucdenver.edu/iao/hp/")
-
-       ("hprd" "http://www.hprd.org/")
-       ("iaohprd" "http://kabob.ucdenver.edu/iao/hprd/")
-
-       ("interpro" "http://www.ebi.ac.uk/interpro/")
-       ("iaointerpro" "http://kabob.ucdenver.edu/iao/interpro/")
-
-       ("irefweb" "http://wodaklab.org/iRefWeb/")
-       ("iaoirefweb" "http://kabob.ucdenver.edu/iao/irefweb/")
-
-       ("kegg" "http://www.genome.jp/kegg/")
-       ("iaokegg" "http://kabob.ucdenver.edu/iao/kegg/")
-
-       ("obomi" "http://purl.obolibrary.org/obo/mi#")
-       ;;("mi" "http://purl.org/obo/owl/MI#")
-       ("iaomi" "http://kabob.ucdenver.edu/iao/mi/")
-
-       ("mgi" "http://www.informatics.jax.org/")
-       ("iaomgi" "http://kabob.ucdenver.edu/iao/mgi/")
-
-       ;;("mod" "http://purl.org/obo/owl/MOD#")
-       ("iaomod" "http://kabob.ucdenver.edu/iao/mod/")
-
-       ;;("mpheno" "http://purl.org/obo/owl/MP#")
-       ("iaompheno" "http://kabob.ucdenver.edu/iao/mpheno/")
-
-       ;;("ncbitaxon" "http://purl.org/obo/owl/NCBITaxon#")
-       ("iaoncbitaxon" "http://kabob.ucdenver.edu/iao/ncbitaxon/")
-
-       ("omim" "http://www.ncbi.nlm.nih.gov/omim/")
-       ("iaoomim" "http://kabob.ucdenver.edu/iao/omim/")
-
-       ("pharmgkb" "http://www.pharmgkb.org/")
-       ("iaopharmgkb" "http://kabob.ucdenver.edu/iao/pharmgkb/")
-
-       ("premod" "http://genomequebec.mcgill.ca/PReMod/")
-       ("iaopremod" "http://kabob.ucdenver.edu/iao/premod/")
-
-       ("iaopw" "http://kabob.ucdenver.edu/iao/pw/")
-
-       ;;("pr" "http://purl.obolibrary.org/obo/")
-       ("iaopr" "http://kabob.ucdenver.edu/iao/pr/")
-
-       ("reactome" "http://www.reactome.org/")
-       ("iaoreactome" "http://kabob.ucdenver.edu/iao/reactome/")
-
-       ("refseq" "http://www.ncbi.nlm.nih.gov/refseq/")
-       ("iaorefseq" "http://kabob.ucdenver.edu/iao/refseq/")
-
-       ;;("rgd" "http://rgd/")
-       ("iaorgd" "http://kabob.ucdenver.edu/iao/rgd/")
-
-       ;;("ro" "http://www.obofoundry.org/ro/ro.owl#")
-       ("iaoro" "http://kabob.ucdenver.edu/iao/ro/")
-       ;;("kro" "http://kabob.ucdenver.edu/iao/ro/")
-       ("kro" "http://kabob.ucdenver.edu/ro/")
-
-       ;;("so" "http://purl.org/obo/owl/SO#")
-       ("iaoso" "http://kabob.ucdenver.edu/iao/so/")
-       ("kso" "http://kabob.ucdenver.edu/so/")
-
-       ("transfac" "http://www.gene-regulation.com/transfac/")
-       ("iaotransfac" "http://kabob.ucdenver.edu/iao/transfac/")
-
-       ("uniprot" "http://purl.uniprot.org/uniprot/")
-       ("iaouniprot" "http://kabob.ucdenver.edu/iao/uniprot/")
-
-       ("iaouberon" "http://kabob.ucdenver.edu/iao/uberon/")
+       ;("kiao" "http://kabob.ucdenver.edu/iao/")
+       ;("kabob" "http://kabob.ucdenver.edu/")
+       ;("kbio" "http://kabob.ucdenver.edu/bio/")
+       ;
+       ;;;in domain
+       ;("bfo" "http://www.ifomis.org/bfo/1.1#")
+       ;("iaobfo" "http://kabob.ucdenver.edu/iao/bfo/")
+       ;
+       ;;;("bto" "http://purl.org/obo/owl/BTO#")
+       ;("iaobto" "http://kabob.ucdenver.edu/iao/bto/")
+       ;
+       ;;;("chebi" "http://purl.org/obo/owl/CHEBI#")
+       ;("iaochebi" "http://kabob.ucdenver.edu/iao/chebi/")
+       ;
+       ;;;("cl" "http://purl.org/obo/owl/CL#")
+       ;("iaocl" "http://kabob.ucdenver.edu/iao/cl/")
+       ;
+       ;("dip" "http://dip.doe-mbi.ucla.edu/dip/")
+       ;("iaodip" "http://kabob.ucdenver.edu/iao/dip/")
+       ;
+       ;;;("drugbank" "")
+       ;("iaodrugbank" "http://kabob.ucdenver.edu/iao/drugbank/")
+       ;
+       ;("ecocyc" "http://ecocyc.org/")
+       ;("iaoecocyc" "http://kabob.ucdenver.edu/iao/ecocyc/")
+       ;
+       ;("eg" "http://www.ncbi.nlm.nih.gov/gene/")
+       ;("iaoeg" "http://kabob.ucdenver.edu/iao/eg/")
+       ;
+       ;("embl" "http://www.ebi.ac.uk/embl/")
+       ;("iaoembl" "http://kabob.ucdenver.edu/iao/embl/")
+       ;
+       ;("gad" "http://geneticassociationdb.nih.gov/")
+       ;("iaogad" "http://kabob.ucdenver.edu/iao/gad/")
+       ;
+       ;("gensat" "http://gensat.org/")
+       ;("iaogensat" "http://kabob.ucdenver.edu/iao/gensat/")
+       ;
+       ;;;("go" "http://purl.org/obo/owl/GO#")
+       ;("iaogo" "http://kabob.ucdenver.edu/iao/go/")
+       ;
+       ;("goa" "http://www.ei.ac.uk/GOA/")
+       ;("iaogoa" "http://kabob.ucdenver.edu/iao/goa/")
+       ;
+       ;;("hgnc" "http://www.genenames.org/hgnc/")
+       ;;("iaohgnc" "http://kabob.ucdenver.edu/iao/hgnc/")
+       ;
+       ;("homologene" "http://www.ncbi.nlm.nih.gov/homologene/")
+       ;("iaohomologene" "http://kabob.ucdenver.edu/iao/homologene/")
+       ;
+       ;("iaohp" "http://kabob.ucdenver.edu/iao/hp/")
+       ;
+       ;("hprd" "http://www.hprd.org/")
+       ;("iaohprd" "http://kabob.ucdenver.edu/iao/hprd/")
+       ;
+       ;("interpro" "http://www.ebi.ac.uk/interpro/")
+       ;("iaointerpro" "http://kabob.ucdenver.edu/iao/interpro/")
+       ;
+       ;("irefweb" "http://wodaklab.org/iRefWeb/")
+       ;("iaoirefweb" "http://kabob.ucdenver.edu/iao/irefweb/")
+       ;
+       ;("kegg" "http://www.genome.jp/kegg/")
+       ;("iaokegg" "http://kabob.ucdenver.edu/iao/kegg/")
+       ;
+       ;("obomi" "http://purl.obolibrary.org/obo/mi#")
+       ;;;("mi" "http://purl.org/obo/owl/MI#")
+       ;("iaomi" "http://kabob.ucdenver.edu/iao/mi/")
+       ;
+       ;("mgi" "http://www.informatics.jax.org/")
+       ;("iaomgi" "http://kabob.ucdenver.edu/iao/mgi/")
+       ;
+       ;;;("mod" "http://purl.org/obo/owl/MOD#")
+       ;("iaomod" "http://kabob.ucdenver.edu/iao/mod/")
+       ;
+       ;;;("mpheno" "http://purl.org/obo/owl/MP#")
+       ;("iaompheno" "http://kabob.ucdenver.edu/iao/mpheno/")
+       ;
+       ;;;("ncbitaxon" "http://purl.org/obo/owl/NCBITaxon#")
+       ;("iaoncbitaxon" "http://kabob.ucdenver.edu/iao/ncbitaxon/")
+       ;
+       ;("omim" "http://www.ncbi.nlm.nih.gov/omim/")
+       ;("iaoomim" "http://kabob.ucdenver.edu/iao/omim/")
+       ;
+       ;("pharmgkb" "http://www.pharmgkb.org/")
+       ;("iaopharmgkb" "http://kabob.ucdenver.edu/iao/pharmgkb/")
+       ;
+       ;("premod" "http://genomequebec.mcgill.ca/PReMod/")
+       ;("iaopremod" "http://kabob.ucdenver.edu/iao/premod/")
+       ;
+       ;("iaopw" "http://kabob.ucdenver.edu/iao/pw/")
+       ;
+       ;;;("pr" "http://purl.obolibrary.org/obo/")
+       ;("iaopr" "http://kabob.ucdenver.edu/iao/pr/")
+       ;
+       ;("reactome" "http://www.reactome.org/")
+       ;("iaoreactome" "http://kabob.ucdenver.edu/iao/reactome/")
+       ;
+       ;("refseq" "http://www.ncbi.nlm.nih.gov/refseq/")
+       ;("iaorefseq" "http://kabob.ucdenver.edu/iao/refseq/")
+       ;
+       ;;;("rgd" "http://rgd/")
+       ;("iaorgd" "http://kabob.ucdenver.edu/iao/rgd/")
+       ;
+       ;;;("ro" "http://www.obofoundry.org/ro/ro.owl#")
+       ;("iaoro" "http://kabob.ucdenver.edu/iao/ro/")
+       ;;;("kro" "http://kabob.ucdenver.edu/iao/ro/")
+       ;("kro" "http://kabob.ucdenver.edu/ro/")
+       ;
+       ;;;("so" "http://purl.org/obo/owl/SO#")
+       ;("iaoso" "http://kabob.ucdenver.edu/iao/so/")
+       ;("kso" "http://kabob.ucdenver.edu/so/")
+       ;
+       ;("transfac" "http://www.gene-regulation.com/transfac/")
+       ;("iaotransfac" "http://kabob.ucdenver.edu/iao/transfac/")
+       ;
+       ;("uniprot" "http://purl.uniprot.org/uniprot/")
+       ;("iaouniprot" "http://kabob.ucdenver.edu/iao/uniprot/")
+       ;
+       ;("iaouberon" "http://kabob.ucdenver.edu/iao/uberon/")

        ("iaohan" "http://kabob.ucdenver.edu/iao/hanalyzer/")
        ))


stop flickering on Windows

stop flickering on Windows

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

--- plugins/SlideExplorer2/src/slide_explorer/display.clj
+++ plugins/SlideExplorer2/src/slide_explorer/display.clj
@@ -1,6 +1,7 @@
 (ns slide-explorer.display
-  (:import (javax.swing AbstractAction JComponent JFrame JLabel KeyStroke)
-           (java.awt Canvas Color Graphics Graphics2D RenderingHints Window)
+  (:import (javax.swing AbstractAction JComponent JFrame JPanel JLabel KeyStroke
+                        SwingUtilities)
+           (java.awt Color Graphics Graphics2D RenderingHints Window)
            (java.awt.event ComponentAdapter KeyAdapter KeyEvent MouseAdapter
                            WindowAdapter)
            (java.awt.image BufferedImage WritableRaster)
@@ -9,7 +10,8 @@
            (java.util UUID)
            (java.util.prefs Preferences)
            (javax.imageio ImageIO)
-           (ij ImagePlus ImageProcessor)
+           (ij ImagePlus)
+           (ij.process ImageProcessor)
            (mmcorej TaggedImage)
            (org.micromanager AcqEngine MMStudioMainFrame)
            (org.micromanager.utils GUIUpdater ImageUtils JavaUtils MDUtils)
@@ -242,10 +244,9 @@
         (.drawImage g image
                     x y nil)))))

-(defn paint-screen [canvas screen-state available-tiles]
-  (let [g (.getGraphics canvas)
-        original-transform (.getTransform g)]
-    (doto g
+(defn paint-screen [graphics screen-state available-tiles]
+  (let [original-transform (.getTransform graphics)]
+    (doto graphics
       (.translate (+ (:x @screen-state) (/ (:width @screen-state) 2))
                   (+ (:y @screen-state) (/ (:height @screen-state) 2)))
       (.rotate @angle)
@@ -304,16 +305,19 @@
   (bind-window-key window "ADD" #(swap! zoom-atom update-in [:zoom] inc))
   (bind-window-key window "SUBTRACT" #(swap! zoom-atom update-in [:zoom] dec)))

-(defn display-follow [canvas reference]
+(defn display-follow [panel reference]
   (add-watch reference "display"
     (fn [_ _ _ _]
-      (.repaint canvas))))
-
-(defn main-canvas [screen-state available-tiles]
+      (.repaint panel))))
+
+(defn main-panel [screen-state available-tiles]
   (doto
-    (proxy [Canvas] []
-      (paint [^Graphics g] (paint-screen this screen-state available-tiles)))
-    (.setBackground Color/BLACK)))
+    (proxy [JPanel] []
+      (paintComponent [^Graphics graphics]
+                      (proxy-super paintComponent graphics)
+                      (paint-screen graphics screen-state available-tiles)))
+    (.setBackground Color/BLACK)
+    ))

 (defn main-frame []
   (doto (JFrame. "Slide Explorer II")
@@ -323,21 +327,21 @@
 (defn show []
   (let [screen-state (atom (sorted-map :x 0 :y 0 :z 0 :zoom 0))
         available-tiles (agent {})
-        canvas (main-canvas screen-state available-tiles)
+        panel (main-panel screen-state available-tiles)
         frame (main-frame)]
     (def at available-tiles)
     (def ss screen-state)
     (def f frame)
-    (def cvs canvas)
-    (.add (.getContentPane frame) canvas)
+    (def pnl panel)
+    (.add (.getContentPane frame) panel)
     (setup-fullscreen frame)
-    (handle-drags canvas screen-state)
-    (handle-wheel canvas screen-state)
-    (handle-resize canvas screen-state)
+    (handle-drags panel screen-state)
+    (handle-wheel panel screen-state)
+    (handle-resize panel screen-state)
     (handle-zoom frame screen-state)
-    (display-follow canvas screen-state)
-    (display-follow canvas available-tiles)
-    (display-follow canvas angle)
+    (display-follow panel screen-state)
+    (display-follow panel available-tiles)
+    (display-follow panel angle)
     frame))


fix broken compilation on Windows (3rd attempt)

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

--- plugins/SlideExplorer2/src/slide_explorer/widgets.clj
+++ plugins/SlideExplorer2/src/slide_explorer/widgets.clj
@@ -9,6 +9,17 @@
   (try
     (do (eval form) true)
     (catch Throwable _ false)))
+
+(defn attempt-eval
+  [form default]
+  (try
+    (eval form)
+    (catch Throwable _ default)))
+
+(defmacro attempt-defn [& body]
+  `(attempt-eval
+     '(defn ~@body)
+     (def ~(first body) (constantly nil))))

 (def new-mac-full-screen
   (can-eval? '(do (import com.apple.eawt.FullScreenUtilities)
@@ -101,12 +112,10 @@

 (def old-bounds (atom {}))

-(def mac-new-toggle-full-screen
-  (attempt-eval
-    '(fn [window]
-       (.requestToggleFullScreen
-         (eval `(Application/getApplication)) window))
-    (constantly nil)))
+(attempt-defn mac-new-toggle-full-screen
+  [window]
+  (.requestToggleFullScreen
+    (Application/getApplication) window))

 (defn full-screen!
   "Make the given window/frame full-screen."
@@ -155,14 +164,7 @@
       (exit-full-screen! window)
       (full-screen! window))))

-(defn attempt-eval [form default]
-  (try
-    (eval form)
-    (catch Throwable _ default)))
-
-(def new-mac-enable-full-screen
-  (attempt-eval
-    '(fn [window]
+(attempt-defn new-mac-enable-full-screen [window]
        (FullScreenUtilities/setWindowCanFullScreen window true)
        (FullScreenUtilities/addFullScreenListenerTo window
          (proxy [FullScreenAdapter] []
@@ -172,7 +174,6 @@
          (windowExitingFullScreen [_])
          (windowExitedFullScreen [_]
            (swap! fullscreen-windows disj window)))))
-    (constantly nil)))

 (defn setup-fullscreen
   "Endows the given window with the ability to enter and exit full screen.


doseq is a little cleaner for tf-idf-document.

--- project/analyze-data/src/analyze_data/tf_idf/core.clj
+++ project/analyze-data/src/analyze_data/tf_idf/core.clj
@@ -42,11 +42,10 @@
                                         (map-indexed #(vector %1 %2))
                                         (filter #(not= 0.0 (second %)))
                                         all-terms)
-        array (m/new-sparse-array [(count all-terms)])
-        set-value (fn [[index value]] (m/mset! array index value))]
-    (run! set-value indexed-tf-idf-values)
+        array (m/new-sparse-array [(count all-terms)])]
+    (doseq [[index value] indexed-tf-idf-values]
+      (m/mset! array index value))
     array))
-

 (defn tf-idf
   "Calculates (term frequency * inverse document frequency) values for a


infinitive verbs with irregular present tense should have inflection: :infinitive

--- babel/francais.clj
+++ babel/francais.clj
@@ -27,6 +27,21 @@

               ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
               transitivize
+
+              ;; make infinitive verbs with irregular present tense have inflection: :infinitive for their infinitive form.
+              ;; TODO: should do this for verbs that have *any* irregular forms - present tense or other.
+              (map-function-on-map-vals
+               (fn [k vals]
+                 (map (fn [val]
+                        (cond (and (= (get-in val [:synsem :cat])
+                                      :verb)
+                                   (= :top (get-in val [:synsem :infl]))
+                                   (not (= :none (get-in val [:français :present] :none))))
+                              (unify val
+                                     {:synsem {:infl :infinitive}})
+                              true
+                              val))
+                      vals)))

               ;; Cleanup functions can go here. Number them for ease of reading.
               ;; 1. this filters out any verbs without an inflection: infinitive verbs should have inflection ':infinitive',


Update outdated documentation for defview

--- src/main/app_macros/view.clj
+++ src/main/app_macros/view.clj
@@ -124,14 +124,16 @@

    Takes an optional properties spec, an optional computed properties
    spec and an arbitrary number of Om Next component functions (such
-   as ident, query, query-params, initLocalState render) and
-   JavaScript object methods, without requiring their protocols to
-   be included in the definition.
+   as ident, query, query-params, initLocalState or render) and
+   JavaScript object methods, without requiring their protocols or
+   argument bindings (like [this] or [props]) to be included in the
+   definition.

    Based on the properties and computed properties spec, defview
-   will wrap the function bodys of all instance functions (ident,
-   render, lifecycle functions) in a destructuring let that makes
-   the specified properties available inside the function.
+   will wrap the function bodies of all instance functions (ident,
+   render, lifecycle functions, any object methods) in a destructuring
+   let that makes the specified properties available inside these
+   functions.

    Usage:

@@ -153,10 +155,6 @@
    The above example would define the following:

      * An Om Next component called User
-     * A component factory called user
-     * A keyfn function called user-keyfn that is passed
-       to the factory
-     * A validator function called user-validator that is
-       passed to the factory"
+     * A component factory called user, with a :keyfn and a :validator"
   [name & forms]
   (defview* name forms &env))


defbufferop beotch!

defbufferop beotch!

--- src/clj/forma/hadoop/jobs/cdm.clj
+++ src/clj/forma/hadoop/jobs/cdm.clj
@@ -9,6 +9,18 @@
             [forma.reproject :as r]
             [forma.date-time :as date]
             [cascalog.ops :as c]))
+
+(defbufferop min-period
+  "Returns the minimum value in tuples."
+  [tuples]
+  [(reduce min (map first tuples))])
+
+(defn yomama []
+  (let [src [[1 1 16 2] [1 1 16 1]]]
+  (??<- [?x ?y ?z ?p]
+        (src ?x ?y ?z ?p)
+        ;; (min-period ?p :> ?minp)
+        )))

 (defn first-hit
   "Returns the first value in a vector of numbers that is greater than or equal


Complete ai action handling

Complete ai action handling

--- src/cljs/love_letter_cljs/ai.cljs
+++ src/cljs/love_letter_cljs/ai.cljs
@@ -76,10 +76,9 @@
 (defn player-hand [game id]
   (get-in game [:players id :hand]))

-
 (defn filter-fresh-deck [card-list]
   (reduce (fn [deck card]
-           (u/remove-first card deck)) complete-deck card-list))
+            (u/remove-first card deck)) complete-deck card-list))

 (defn high-card [game card]
   (let [{:keys [discard-pile current-player]} game
@@ -167,8 +166,7 @@
         :countess   0
         :default    0))))

-
-(defn contains-attack-card? [hand]
+(defn- contains-attack-card? [hand]
   (let [faces (set (map :face hand))]
     (some faces [:baron :guard :prince])))

@@ -294,6 +292,7 @@
 (defn generate-card-actions [game card]
   (let [high-card-action (generate-high-card-action game card)
         targets (u/valid-targets game)]
+    (cons high-card-action
           (case (:face card)
             :guard  (map #(guard-elimination-action game %) (guard-prob-inputs game))
             :priest (map #(priest-assist-action game %) targets)
@@ -304,26 +303,88 @@
             :king     (map #(king-assist-action game %) targets)
             :countess [(countess-bluff-action game)]
             :princess [(princess-suicide-action game)]
-            :default [])))
+            :default  []))))
+
+(defn normalize-hand [hand]
+  (vec (set (map #(select-keys % [:face :value]) hand))))

 (defn generate-actions [game player-id]
-  (->> (mapcat #(generate-card-actions game %) (player-hand game player-id))
+  (->> (mapcat #(generate-card-actions game %) (normalize-hand (player-hand game player-id)))
        (sort-by :strength)
        reverse))

+(defn other-card-actions [best-action actions]
+  (filter #(and (not= (:type %) :high-card)
+                (not= (:active-card (:action %))
+                      (:active-card (:action best-action)))) actions))
+
+(defn other-card-face [best-action actions]
+  (:active-card (:action (first (filter #(not= (:active-card (:action best-action)) (:active-card (:action %))) actions)))))
+
+(defn same-card-actions [best-action actions]
+  (filter #(and (not= (:type %) :high-card)
+                (= (:active-card (:action %))
+                   (:active-card (:action best-action)))) actions))
+
+(defn no-op-action [face current-player]
+  {:action {:active-card face
+            :card-target nil
+            :current-player current-player
+            :guard-guess nil}})
+
 (defn pick-action [actions]
-  (let [best-action (first actions)]
+  (let [best-action   (first actions)]
     (if (not= :high-card (:type best-action))
       best-action
-      (first (drop-while #(or (= (:type %) :high-card)
-                              (= (:active-card (:action %)) (:active-card (:action best-action))))
-                         actions)))))
-
-#_[{:action {:target nil
-             :guard-guess nil
-             :active-card nil
-             :current-player nil}
-    :type :defense
-    :strength 100}]
-
-
+      (let [other-actions (other-card-actions best-action actions)
+            other-face    (other-card-face best-action actions)
+            same-actions  (same-card-actions best-action actions)]
+        (if (nil? other-face)
+          (if (empty? same-actions)
+            (no-op-action (:active-card (:action best-action)) (:current-player (:action best-action)))
+            (first same-actions))
+          (if (empty? other-actions)
+            (no-op-action other-face (:current-player (:action best-action)))
+            (first other-actions)))))))
+
+
+(def no-op-test
+  {:deck
+   [{:face :princess, :value 8, :visible []}
+    {:face :prince, :value 5, :visible []}
+    {:face :priest, :value 2, :visible []}
+    {:face :guard, :value 1, :visible []}
+    {:face :handmaid, :value 4, :visible []}],
+   :debug-mode? true,
+   :display-card nil,
+   :phase :draw,
+   :discard-pile
+   [{:face :guard, :value 1, :visible []}
+    {:face :king, :value 6, :visible []}
+    {:face :priest, :value 2, :visible []}
+    {:face :baron, :value 3, :visible []}
+    {:face :guard, :value 1, :visible [3]}
+    {:face :prince, :value 5, :visible []}
+    {:face :baron, :value 3, :visible []}
+    {:face :handmaid, :value 4, :visible []}],
+   :burn-pile [{:face :guard, :value 1, :visible []}],
+   :card-target nil,
+   :guard-guess nil,
+   :active-card :handmaid,
+   :players
+   {1 {:id 1, :hand [], :alive? false, :protected? false},
+    2 {:id 2, :hand [], :alive? false, :protected? false},
+    3
+    {:id 3,
+     :hand [{:face :guard, :value 1, :visible []}],
+     :alive? true,
+     :protected? false},
+    4
+    {:id 4,
+     :hand [{:face :countess, :value 7, :visible []}],
+     :alive? true,
+     :protected? true}},
+   :log [],
+   :current-player 3}
+  )
+


fox validation rule to accept two + decimal numbers

--- src/cljs/material/validation.cljs
+++ src/cljs/material/validation.cljs
@@ -19,7 +19,7 @@
                       (let [val (str value)]
                         (if (empty? val)
                           true
-                          (some? (re-matches #"^[4-9][0-9]*$" val))))))
+                          (some? (re-matches #"(([1-4]\d|[4-9])\d*)$" val))))))

 (.addValidationRule js/Formsy "isValidCPUValue"
                     (fn [_ value]


[MC/EC][73156982] fixes bug parsing cmdline args

long-name "--body BODY" creates a key ":body Body" in the options map
so we're shortening to "--body" for now, which does what we want.

--- src/com/rentpath/emailer/core.clj
+++ src/com/rentpath/emailer/core.clj
@@ -13,21 +13,21 @@
 (defn- parse-args
   [args]
   (cli args
-    ["-a" "--attachment FILE" "Attachment file"]
-    ["-b" "--body BODY" "Message body"]
-    ["-c" "--cc CC" "CC:"]
-    ["-f" "--from FROM" "From:"]
-    ["-H" "--smtphost HOST" "SMTP host"
+    ["-a" "--attachment" "Attachment file"]
+    ["-b" "--body" "Message body"]
+    ["-c" "--cc" "CC:"]
+    ["-f" "--from" "From:"]
+    ["-H" "--smtphost" "SMTP host"
       :default "smtp.gmail.com"]
-    ["-p" "--password PASSWORD" "SMTP password"]
-    ["-P" "--port PORT" "SMTP Port number"
+    ["-p" "--password" "SMTP password"]
+    ["-P" "--port" "SMTP Port number"
       :default 465
       :parse-fn #(Integer/parseInt %)
       :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]
-    ["-s" "--subject SUBJECT" "Subject:"]
-    ["-S" "--ssl SSL" "If present, use SSL" :default false :flag true]
-    ["-t" "--to TO" "To:"]
-    ["-u" "--username USER" "SMTP username"]
+    ["-s" "--subject" "Subject:"]
+    ["-S" "--ssl" "If present, use SSL" :default false :flag true]
+    ["-t" "--to" "To:"]
+    ["-u" "--username" "SMTP username"]
     ["-?" "--help" "Show this help" :default false :flag true]))


fixing tests

fixing tests

--- test/celestial/test/api.clj
+++ test/celestial/test/api.clj
@@ -50,6 +50,7 @@
     (fact "provisioning job"
           (non-sec-app (request :post "/job/provision/1")) => (contains {:status 200})
           (provided
+            (p/system-exists? "1") => true
             (p/get-system "1")  => machine
             (p/get-type "redis") => type
             (jobs/enqueue "provision" {:identity "1" :args [type (assoc machine :system-id 1)]}) => nil)))
@@ -57,6 +58,7 @@
 (fact "staging job"
       (non-sec-app (request :post "/job/stage/1")) => (contains {:status 200})
       (provided
+        (p/system-exists? "1") => true
         (p/get-system "1") => {}
         (jobs/enqueue "stage" {:identity "1" :args [{:system-id 1}]}) => nil))


Testing distributing N x

Testing distributing N x

where N > 2

--- src/test/clojure/stl_collector/flattener_test.clj
+++ src/test/clojure/stl_collector/flattener_test.clj
@@ -35,9 +35,14 @@
           buffer 5.0]
       (is (= [] (f/collect machine buffer [stl]))))))

-(deftest foo
+(deftest x-axis
   (testing "distributes two stl across the x axis"
     (let [machine [45.0 20.0 20.0]
           buffer 5.0
           expected (t/normalize (t/combine (t/distribute-x (repeat 2 (t/facify stl)) buffer)))]
-      (is (= expected (f/collect machine buffer [stl stl]))))))
+      (is (= expected (f/collect machine buffer [stl stl])))))
+  (testing "distributes three stl across the x axis"
+    (let [machine [70.0 20.0 20.0]
+          buffer 5.0
+          expected (t/normalize (t/combine (t/distribute-x (repeat 3 (t/facify stl)) buffer)))]
+      (is (= expected (f/collect machine buffer [stl stl stl]))))))


Pretty printing tables

Pretty printing tables

--- src/app/operations.clj
+++ src/app/operations.clj
@@ -9,6 +9,9 @@

 (defmethod toString String [x]
   x)
+
+(defmethod toString clojure.lang.Keyword [x]
+  (name x))

 (defmethod toString ClassOrInterfaceDeclaration [x]
   (getQName x))
@@ -26,6 +29,8 @@
   (if (= ind 0)
     (first l)
     (getN (rest l) (- ind 1))))
+
+(def columnSeparator " | ")

 (defn columnLength [headerStr resultsStrs ind]
   (max
@@ -57,13 +62,18 @@
     ""
     (str
       (padStr (first values) (first lengths))
+      (if (not (empty? (rest lengths)))
+        columnSeparator
+        "")
       (rowStr (rest lengths) (rest values)))))

 (defn sum [v]
   (apply + v))

 (defn separatorStr [lengths]
-  (let [n (sum lengths)]
+  (let [sumLenRows (sum lengths)
+        sumLenSeparators (* (- (.length lengths) 1) (.length columnSeparator))
+        n (+ sumLenRows sumLenSeparators)]
     (clojure.string/join (repeat n "-"))))

 (defn printTable [headers results]


run sentences with pmap to take advantage of multiple cores

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -83,20 +83,25 @@
                   :synsem {:cat :verb}})]
     (println (str "count: " count))
     (println (str "spec:" spec))
-    (doall (take count (repeatedly
-                        #(let [expr (generate spec
-                                              :model model)
-                               fo (fo expr :show-notes false)]
-                           (let [to-print
-                                 (cond
-                                   (empty? fo) (str "(failed)")
-                                   true
-                                   (str (string/capitalize (nth fo 0))
-                                        (string/join "" (rest (vec fo)))
-                                        "."))]
-                             (println to-print))))))))
+    (doall (pmap
+            (fn [num]
+              (let [expr (generate spec
+                                   :model model)
+                    fo (fo expr :show-notes false)]
+                (let [to-print
+                      (cond
+                        (empty? fo) (str "(failed)")
+                        true
+                        (str (string/capitalize (nth fo 0))
+                             (string/join "" (rest (vec fo)))
+                             "."))]
+                  (println (str num ". " to-print)))))
+            (range 0 count)))))

+
+
+


add ant argline fn

add ant argline fn

--- src/cake/ant.clj
+++ src/cake/ant.clj
@@ -100,6 +100,9 @@
   (doseq [a (remove nil? (flatten args))]
     (.. task createArg (setValue a))))

+(defn argline [task args]
+  (.. task createArg (setLine args)))
+
 (defn sys [task map]
   (doseq [[key val] map]
     (.addSysproperty task


Correctly sets up mongodb connection by connecting with config/storage.

--- src/cadence/server.clj
+++ src/cadence/server.clj
@@ -37,7 +37,7 @@
     (if (not= mode :dev) (server/add-middleware require-https))
     (server/add-middleware wrap-gzip)
     (server/add-middleware friend/authenticate friend-settings)
-    (model/connect)
+    (model/connect config/storage)
     (server/start port (let [opts {:mode mode
                                    :ns 'cadence}]
                          (if (not= mode :dev)


format error msg

format error msg

--- src/ci3/agent/core.clj
+++ src/ci3/agent/core.clj
@@ -106,7 +106,7 @@
                         (get-in build [:commit :message]) " \n"
                         "By: " (or (get-in build [:commit :author :raw]) (get-in build [:commit :author :name])) " \n"
                         base-url "builds/" (get-in build [:metadata :name])
-                        (when text (str " \n ```" (err-msg (json/generate-string text)) "```") ))))
+                        (when text (str " \n ```\n" (err-msg (json/generate-string text)) "\n```") ))))

 (defn error [build res]
   (println build)


Fixed exception on headless environment

Fixed exception on headless environment

--- src/clj/asols/core.clj
+++ src/clj/asols/core.clj
@@ -1,5 +1,6 @@
 (ns asols.core
   (:gen-class :main true)
+  (:import java.awt.HeadlessException)
   (:require [clojure.java.browse :refer [browse-url]]
             [asols.server :as server]))

@@ -9,4 +10,6 @@
         port (Integer/parseInt (or (second args) "8000"))]
     (server/run :ip ip :port port)
     (prn "Server started")
-    (browse-url (str "http://" ip ":" port))))+    (try
+      (browse-url (str "http://" ip ":" port))
+      (catch HeadlessException _))))


adding parallelize with 3 args

adding parallelize with 3 args

--- src/clj/flambo/api.clj
+++ src/clj/flambo/api.clj
@@ -47,8 +47,9 @@
 (defn text-file [spark-context filename]
   (.textFile spark-context filename))

-(defn parallelize [spark-context lst]
-  (.parallelize spark-context lst))
+(defn parallelize
+  ([spark-context lst] (.parallelize spark-context lst))
+  ([spark-contect lst num-slices] (.parallelize spark-context lst num-slices)))

 ;;; Transformations


Get vars referred again after restructure

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -61,11 +61,25 @@
           (with-meta sym (assoc (meta value-var) :ns (the-ns ns)))
           @value-var))

+(def startup-code
+  '(do
+    (def exit reply.main/exit)
+    (def quit reply.main/exit)
+    (def help reply.main/help)
+    (defmacro clojuredocs
+      ([sym] `(cd-client.core/pr-examples ~sym))
+      ([ns sym] `(cd-client.core/pr-examples ~ns ~sym)))))
+
 (defn setup-conveniences []
-  (intern 'user 'exit exit)
-  (intern 'user 'quit exit)
-  (intern 'user 'help help)
-  (intern-with-meta 'user 'clojuredocs #'cd/pr-examples))
+  (in-ns 'user)
+  (use '[clojure.repl :only (source apropos dir pst doc find-doc)])
+  (use '[clojure.java.javadoc :only (javadoc)])
+  (use '[clojure.pprint :only (pp pprint)])
+  (require '[cd-client.core])
+  (eval startup-code)
+  (in-ns 'reply.main))
+
+  ;(intern-with-meta 'user 'clojuredocs #'cd/pr-examples))

 (defn launch [args]
   (set-signal-handler! "INT" handle-ctrl-c)


Fixed all-objects. Now correctly ignores pack files.

--- src/clj_git/object.clj
+++ src/clj_git/object.clj
@@ -102,14 +102,16 @@
        (byte-array)
        (sha-1-hex)))

+(defn is-valid-hash-str [s]
+  (= (count s) SHA-1-HEX-LENGTH))
+
 (defn all-objects []
   (let [object-path (str (git-root) "objects/")
         pref-files (drop 1 (file-seq (clojure.java.io/file object-path)))
         are-files (filter #(.isFile %) pref-files)
-        hashes (map #(str (.getName (.getParentFile %))
+        names (map #(str (.getName (.getParentFile %))
                          (.getName %)) are-files)]
-
-    (map #(do (assert (= (count %) SHA-1-HEX-LENGTH)) %) hashes)))
+    (filter is-valid-hash-str names)))

 (defn complete-hash [hash-prefix]
   (assert (<= (count hash-prefix) SHA-1-HEX-LENGTH))


Remotes

Remotes

--- src/cljs/ufo/core.cljs
+++ src/cljs/ufo/core.cljs
@@ -43,6 +43,13 @@
 (defmethod read :user
   [{:keys [state] :as env} key {:keys [id] :as params}]
   {:value (get-in @state [:users/by-id id])})
+
+(defmethod read :search/user
+  [{:keys [state ast] :as env} key {:keys [id] :as params}]
+  (merge
+   {:value (get-in @state [:users/by-id id])}
+   (when true ;; a condition on id
+     {:search ast})))

 (defmethod mutate 'users/by-id
   [{:keys [state]} _ {:keys [id]}]
@@ -103,8 +110,13 @@
      :cols [:id :fname :lname]}]})

 ;; defonce produces: Encountered two children with the same key, `null`
-(def reconciler (om/reconciler
-                 {:state app-state
-                  :parser (om/parser {:read read :mutate mutate})}))
+(def reconciler
+  (om/reconciler
+   {:state app-state
+    :parser (om/parser {:read read :mutate mutate})
+
+    ;; "I don't know the value of this key, go ask the server"
+    :remotes [:search] ;; remote targets - represent remote services
+    }))

 (om/add-root! reconciler cli/RootView (gdom/getElement "app"))


www/admin.clj: added route for raw log directory

--- src/org/altlaw/www/admin.clj
+++ src/org/altlaw/www/admin.clj
@@ -3,8 +3,9 @@
             org.altlaw.www.admin.NorobotsResource
             org.altlaw.www.admin.MenuResource
             [clojure.contrib.shell-out :as sh])
-  (:import (org.restlet Router Guard)
-           (org.restlet.data ChallengeScheme)))
+  (:import (org.restlet Router Guard Directory)
+           (org.restlet.data ChallengeScheme)
+           (java.io File)))

 (defn- make-admin-guard [context next]
   (doto (Guard. context ChallengeScheme/HTTP_DIGEST
@@ -25,12 +26,18 @@
 (defn- make-command-restlet [context args]
   (make-fn-restlet context (fn [] (sh-in-thread args))))

+(defn- logs-uri []
+  (str "file://" (.getAbsolutePath (File. (context/altlaw-home)))
+       "/var/log/" (context/altlaw-env)))
+
 (defn- make-admin-router [context]
   (doto (Router. context)
     (.attach "/norobots" org.altlaw.www.admin.NorobotsResource)
     (.attach "/update-code" (make-command-restlet context ["git" "pull"]))
     (.attach "/recompile" (make-command-restlet context ["ant"]))
     (.attach "/make-content-pages" (make-fn-restlet context org.altlaw.www.content-pages/save-static-pages))
+    (.attach "/logs" (doto (Directory. context (logs-uri))
+                       (.setListingAllowed true)))
     (.attach "" org.altlaw.www.admin.MenuResource)))

 (defn make-guarded-admin-router [context]


simplify implementation

simplify implementation

--- src/overtone/helpers/seq.clj
+++ src/overtone/helpers/seq.clj
@@ -48,6 +48,5 @@
   "Returns a lazy sequence of a depth-first traversal of zipper z"
   [z]
   (lazy-seq
-    (if (zip/end? z)
-      nil
+    (when-not (zip/end? z)
       (cons (zip/node z) (zipper-seq (zip/next z))))))


Automatically closing server in with-routes! macro

--- src/fake_http/core.clj
+++ src/fake_http/core.clj
@@ -168,4 +168,7 @@
   `(let [routes# ~routes]
      (let [server# (start! routes#)
            ~'uri (:uri server#)]
-       ~@body)))+       (try
+         ~@body
+         (finally
+           (.close server#))))))