simplied close-childs

simplied close-childs

--- src/main/clojure/pdok/featured/processor.clj
+++ src/main/clojure/pdok/featured/processor.clj
@@ -173,7 +173,7 @@
    :parent-id id})

 (defn- meta-close-childs [features]
-  "{:action :close-childs :dataset _ :collection _ :parent-collection _ :parent-id _ :end-time _"
+  "{:action :close-childs :dataset _ :collection _ :parent-collection _ :parent-id _ :validity _"
   (let [grouped (group-by #(select-keys % [:dataset :collection :parent-collection :parent-id :validity]) features)]
     (letfn [(meta [dataset collection parent-collection parent-id validity]
               {:action :close-childs
@@ -181,7 +181,7 @@
                :collection collection
                :parent-collection parent-collection
                :parent-id parent-id
-               :end-time validity})]
+               :validity validity})]
       (map (fn [[{:keys [dataset collection parent-collection parent-id validity]} _]]
              (meta dataset collection parent-collection parent-id validity)) grouped)
       )))
@@ -212,35 +212,32 @@
         collected (assoc no-attributes :attributes collected)]
     collected))

-(defn- close-childs* [processor dataset collection id end-time]
+(defn- close-child [processor dataset collection id close-time]
   (let [persistence (:persistence processor)
+        childs-of-child (pers/childs persistence dataset collection id)
+        metas (map (fn [[child-col child-id]] {:action :close-childs
+                                  :dataset dataset
+                                  :collection child-col
+                                  :parent-collection collection
+                                  :parent-id id
+                                  :validity close-time}) childs-of-child)
         validity (pers/current-validity persistence dataset collection id)
         state (pers/last-action persistence dataset collection id)]
-        (when-not (= state :close)
-          (consume processor {:action :close
-                              :dataset dataset
-                              :collection collection
-                              :id id
-                              :current-validity validity
-                              :validity end-time}))))
-
-(defn- close-nested-childs-meta [persistence dataset parent-collection parent-id end-time]
-  (let [nested (pers/childs persistence dataset parent-collection parent-id)
-        metas (map (fn [[col id]] {:dataset dataset
-                                  :collection col
-                                  :parent-collection parent-collection
-                                  :parent-id parent-id
-                                  :end-time end-time}) nested)]
-    metas))
+        (if-not (= state :close)
+          (consume processor (conj metas {:action :close
+                                            :dataset dataset
+                                            :collection collection
+                                            :id id
+                                            :current-validity validity
+                                            :validity close-time}))
+          (consume processor metas))))

 (defn- close-childs [processor meta-record]
-  (let [{:keys [dataset collection parent-collection parent-id end-time]} meta-record
+  (let [{:keys [dataset collection parent-collection parent-id validity]} meta-record
         persistence (:persistence processor)
         ids (pers/childs persistence dataset parent-collection parent-id collection)
-        nested-metas (mapcat #(close-nested-childs-meta persistence dataset collection % end-time) ids)
-        closed-nesteds (doall (mapcat #(close-childs processor %) nested-metas))
-        closed (doall (mapcat #(close-childs* processor dataset collection % end-time) ids))]
-    (concat closed-nesteds closed)))
+        closed (doall (mapcat #(close-child processor dataset collection % validity) ids))]
+     closed))

 (defn- delete-child* [processor dataset collection id]
   (let [persistence (:persistence processor)


beach => artifact=false,place=true

beach => artifact=false,place=true

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -150,6 +150,9 @@
                       :machine false
                       :place false
                       :spec {:of {:human true}}}
+
+   {:pred :beach}    {:artifact false
+                      :place true}

    {:pred :bicycle}  {:artifact true
                       :consumable false


whitespace

whitespace

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -151,6 +151,7 @@
                       :consumable false
                       :event false
                       :place false}
+
    {:pred :name}     {:physical-object false
                       :event false}


cleanup

cleanup

--- src/babel/italiano/lab.cljc
+++ src/babel/italiano/lab.cljc
@@ -343,18 +343,6 @@
    [:synsem :infl]
    [:synsem :sem :pred]])

-(def verbcoach-index-fn
-  (fn [spec]
-    (let [lexicon
-          (into {}
-                (for [[k vals] (:lexicon model)]
-                  (let [filtered-vals
-                        (filter verbcoach-pronouns
-                                vals)]
-                    (if (not (empty? filtered-vals))
-                      [k filtered-vals]))))]
-      (lookup-spec spec (create-indices lexicon verbcoach-index-paths) verbcoach-index-paths)))))
-
 (defn create-index-fn [verb-set grammar]
   (let [lexicon
         (into {}
@@ -377,7 +365,7 @@
 (defn arrabbiarsi
   "generate arrabiarsi sentences with a grammar subset."
   []
-  (let [verb-set #{"arrabbiarsi" "essere" "fermarsi" "parlare" "sedersi"}
+  (let [verb-set #{"arrabbiarsi" "fermarsi" "parlare" "sedersi"}
         grammar
         (filter
          #(contains? verbcoach-grammar (u/get-in % [:rule]))
@@ -400,7 +388,7 @@
 (defn arrabbiarsi-or-sedersi
   "generate arrabiarsi sentences with a grammar subset."
   []
-  (let [verb-set #{"arrabbiarsi" "essere" "fermarsi" "parlare" "sedersi"}
+  (let [verb-set #{"arrabbiarsi" "fermarsi" "parlare" "sedersi"}
         grammar
         (filter
          #(contains? verbcoach-grammar (u/get-in % [:rule]))


access-token should keep its expiration info

Even if refresh-token generation failed, access-token should still keep
its expires_at info

--- src/cerber/stores/token.clj
+++ src/cerber/stores/token.clj
@@ -19,10 +19,10 @@
 (defrecord SqlTokenStore []
   Store
   (fetch [this [key tag]]
-    (if-let [token (first (let [[client-id user-id] (.split key ":"), refresh? (= tag "refresh")]
-                            (if user-id
-                              (db/find-token-by-details {:client-id client-id :user-id user-id} :is-refresh refresh?)
-                              (db/find-token-by-secret  {:secret key :is-refresh refresh?}))))]
+    (when-let [token (first (let [[client-id user-id] (.split key ":"), refresh? (= tag "refresh")]
+                              (if user-id
+                                (db/find-token-by-details {:client-id client-id :user-id user-id} :is-refresh refresh?)
+                                (db/find-token-by-secret  {:secret key :is-refresh refresh?}))))]
       (let [{:keys [client_id user_id secret scope login is_refresh created_at expires_at]} token]
         {:client-id client_id
          :user-id user_id
@@ -126,18 +126,17 @@

     (if (f/failed? access-token)
       access-token
-      (let [refresh-token (or
-                           (find-refresh-token (:id client) (:id user))
-                           (create-token client user scope {:refresh? true}))]
+      (let [refresh-token (or (find-refresh-token (:id client) (:id user))
+                              (create-token client user scope {:refresh? true}))]
         (-> {:access_token secret
              :token_type "Bearer"
-             :created_at created-at}
+             :created_at created-at
+             :expires_in (/ (- (.getTime expires-at)
+                               (.getTime created-at)) 1000)}
             (cond-> scope
               (assoc :scope scope))
             (cond-> (not (f/failed? refresh-token))
-              (assoc :refresh_token (:secret refresh-token)
-                     :expires_in (/ (- (.getTime expires-at)
-                                       (.getTime created-at)) 1000))))))))
+              (assoc :refresh_token (:secret refresh-token))))))))

 (defn refresh-access-token
   [refresh-token]


Ensure the db uri is available when starting the server from REPL.

Missed this on the last commit.

--- src/clj/qualityclj/repl.clj
+++ src/clj/qualityclj/repl.clj
@@ -1,11 +1,12 @@
 (ns qualityclj.repl
-  (:require [cemerick.piggieback :as piggieback]
-            [weasel.repl.websocket :as weasel]
-            [taoensso.timbre :as timbre :refer [info spy]]
-            [qualityclj.handler :refer [app init]]
+  (:require [qualityclj.handler :refer [app init]]
+            [cemerick.piggieback :as piggieback]
+            [environ.core :refer [env]]
             [org.httpkit.server :refer [run-server]]
             [ring.middleware.file-info :refer [wrap-file-info]]
-            [ring.middleware.file :refer [wrap-file]] ))
+            [ring.middleware.file :refer [wrap-file]]
+            [taoensso.timbre :as timbre :refer [info spy]]
+            [weasel.repl.websocket :as weasel]))

 (defonce server (atom nil))

@@ -27,7 +28,7 @@
   "used for starting the server in development mode from REPL"
   [& [port]]
   (let [port (if port (Integer/parseInt port) 8080)]
-    (init)
+    (init (env :db-uri))
     (reset! server (run-server (get-handler) {:port port}))
     (info (str "Server started. View the site at http://localhost:" port))))


update loop

update loop

--- src/clj_opengrok/search.clj
+++ src/clj_opengrok/search.clj
@@ -134,9 +134,9 @@
                  ^Query query ^QueryBuilder qb opts]
   (let [hpp (hits-per-page)
         n (* (dec (:page opts)) hpp)
-        scores (take hpp (drop n (.scoreDocs fdocs)))]
-    (doseq [score scores]
-      (hit (.doc searcher (.doc ^ScoreDoc score)) query qb))
+        scoredocs (take hpp (drop n (.scoreDocs fdocs)))]
+    (doseq [scoredoc scoredocs]
+      (hit (.doc searcher (.doc ^ScoreDoc scoredoc)) query qb))
     (close searcher)))

 (defn- search-page [opts]
@@ -147,10 +147,10 @@
         total-page (total-page fdocs)]
     (page-info (assoc opts :total-page total-page))
     (document searcher fdocs query qb opts)
-    {:total-page total-page :page (:page opts)}))
+    {:total-page total-page}))

 (defn search [opts]
   (read-configuration (:conf opts))
-  (let [context (search-page (assoc opts :page 1))]
-    (doseq [page (range 2 (inc (:total-page context)))]
-      (search-page (assoc opts :page page)))))
+  (loop [page 1]
+    (when (< page (:total-page (search-page (assoc opts :page page))))
+      (recur (inc page)))))


all drop zones that are hit are fired

all drop zones that are hit are fired

--- src/cljs/re_dnd/events.cljs
+++ src/cljs/re_dnd/events.cljs
@@ -257,14 +257,13 @@
         drop-zones-being-hit? :dnd/get-colliding-drop-zone-and-index}
        [_ source-draggable-id source-drop-zone-id]]
    (debug drop-zones-being-hit?)
-   (if-let [[drop-zone-id [[dropped-element-id index]]] (first drop-zones-being-hit?)]
-     (let [options                  (get-in db [:dnd/state :drop-zone-options drop-zone-id])
-           drag-target-hit-dispatch (into (:drop-dispatch options)
-                                          [[source-drop-zone-id source-draggable-id]
-                                           [drop-zone-id dropped-element-id index]])]
-       {:db       (set-all-draggables-to-idle db)
-        :dispatch drag-target-hit-dispatch})
-     {:db (set-all-draggables-to-idle db)})))
+   {:db         (set-all-draggables-to-idle db)
+    :dispatch-n (for [[drop-zone-id [[dropped-element-id index]]] drop-zones-being-hit?]
+                  (let [options                  (get-in db [:dnd/state :drop-zone-options drop-zone-id])
+                        drag-target-hit-dispatch (into (:drop-dispatch options)
+                                                       [[source-drop-zone-id source-draggable-id]
+                                                        [drop-zone-id dropped-element-id index]])]
+                    drag-target-hit-dispatch))}))

 (re-frame/reg-event-db
  :dnd/reorder-drop


Deletes todo but doesn't remove it from the list

--- src/cljs/todo_clj/core.cljs
+++ src/cljs/todo_clj/core.cljs
@@ -1,7 +1,7 @@
 (ns todo-clj.core
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
-            [ajax.core :refer [GET POST]]))
+            [ajax.core :refer [GET POST DELETE]]))

 (enable-console-print!)

@@ -13,10 +13,20 @@
 (defn handler [response cursor]
   (om/update! cursor :todos response))

-(defn todo [todo]
-  (dom/li #js {:key (:id todo) :className "todo"}
-    (:title todo)
-    (dom/button #js {:className "todo__remove"} "x")))
+
+(defn remove-todo [todo]
+  (let [url (:url todo)]
+    (DELETE url {:handler trace
+                 :error-handler trace
+                 :format :json})))
+
+(defn todo-view [todo]
+  (reify
+    om/IRender
+    (render [_]
+      (dom/li #js {:key (str (:id todo) (rand)) :className "todo"}
+              (:title todo)
+              (dom/button #js {:className "todo__remove" :onClick #(remove-todo todo)} "x")))))

 (defn add-todo [app owner]
   (let [title (.-value (om/get-node owner "new-todo"))]
@@ -48,7 +58,8 @@
                         :placeholder "What needs to be done?"
                         :onKeyPress #(handle-key-press % app owner)}
                    nil)
-        (dom/ul nil (map todo (get app :todos)))))))
+        (apply dom/ul nil
+          (map #(om/build todo-view %) (:todos app)))))))

 (om/root
  root-component


Don't share tmp repos between artifacts [#541]

lein-module based projects will share an aether session when deploying,
but we want each module to have it's own session, so they will each have
their own atomic deploy. Without this change, the second and all
subsequent module deploys will fail.

The fix here is to store the tmp repos as a seq, and find the existing
one that matches the current upload, or creating a new one if none
match. This would allow interleaving files for different artifacts in
the same session, which none of the existing tooling does, but who knows
what craziness exists out there?

--- src/clojars/routes/repo.clj
+++ src/clojars/routes/repo.clj
@@ -45,24 +45,35 @@
   (let [filename (if (string? file) file (.getName file))]
     (.endsWith filename ".pom")))

-(defn find-upload-dir [{:keys [upload-dir]}]
-  (let [dir (io/file upload-dir)]
-    (if (and dir (.exists dir))
-      dir
-      (let [dir' (io/file (FileUtils/getTempDirectory)
-                   (str "upload-" (UUID/randomUUID)))]
-        (FileUtils/forceMkdir dir')
-        dir'))))
-
-(defn upload-request [db groupname session f]
+(def metadata-edn "_metadata.edn")
+
+(defn read-metadata [dir]
+  (let [md-file (io/file dir metadata-edn)]
+    (when (.exists md-file)
+      (read-string (slurp md-file)))))
+
+(defn find-upload-dir [group artifact {:keys [upload-dirs]}]
+  (if-let [dir (some (fn [dir]
+                       (let [dir (io/file dir)]
+                         (when (and dir (.exists dir)
+                                 (= [group artifact] ((juxt :group :name) (read-metadata dir))))
+                           dir)))
+                 upload-dirs)]
+    dir
+    (doto (io/file (FileUtils/getTempDirectory)
+            (str "upload-" (UUID/randomUUID)))
+      (FileUtils/forceMkdir))))
+
+(defn upload-request [db groupname artifact session f]
   (with-account
     (fn [account]
-      (let [upload-dir (find-upload-dir session)]
+      (let [upload-dir (find-upload-dir groupname artifact session)]
         (require-authorization db account groupname (partial f account upload-dir))
         ;; should we only do 201 if the file didn't already exist?
         {:status 201
          :headers {}
-         :session (assoc session :upload-dir (.getAbsolutePath upload-dir))
+         :session (update session
+                    :upload-dirs #((fnil conj []) % (.getAbsolutePath upload-dir)))
          :body nil}))))

 (defn find-pom [dir]
@@ -76,8 +87,6 @@
     (if (string? match)
       (= match name)
       (re-find match name))))
-
-(def metadata-edn "_metadata.edn")

 (defn find-artifacts
   ([dir]
@@ -219,7 +228,7 @@
                   (throw-invalid (str "invalid pom file: " (.getMessage e))
                     {:file pom-file}
                     e)))
-          {:keys [group group-path name] :as posted-metadata} (read-string (slurp (io/file dir metadata-edn)))]
+          {:keys [group group-path name] :as posted-metadata} (read-metadata dir)]

       ;; since we trigger on maven-metadata.xml, we don't actually
       ;; have the sums for it because they are uploaded *after* the
@@ -263,6 +272,7 @@
     (upload-request
       db
       groupname
+      artifact
       session
       (fn [_ upload-dir]
         (spit (io/file upload-dir metadata-edn)
@@ -296,6 +306,7 @@
               (upload-request
                 db
                 groupname
+                artifact
                 session
                 (fn [account upload-dir]
                   (let [file (io/file upload-dir group artifact file)]


Fixed little "empty output" bug in conexp.contrib.todo

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

--- src/conexp/contrib/todo.clj
+++ src/conexp/contrib/todo.clj
@@ -6,38 +6,41 @@
 ;; the terms of this license.
 ;; You must not remove this notice, or any other, from this software.

-(ns
-    #^{:doc "Provides information on all tasks planned for conexp-clj."}
-  conexp.contrib.todo
-  (:use clojure.contrib.def)
-  (:use [clojure.contrib.string :only (split)])
-  (:use [clojure.contrib.pprint :only (pprint)]))
+(ns conexp.contrib.todo
+  (:use conexp)
+  (:use [clojure.contrib.string :only (split)]
+	[clojure.contrib.pprint :only (pprint)]))
+
+(update-ns-meta! conexp.contrib.todo
+  :doc "Provides information on all tasks planned for conexp-clj.")

 ;;;

 (defvar- *conexp-todo-list*
-  { "conexp" { "layout" { "force"    [ "Implement force layout with derivations?" ],
-			  "zschalig" [ "Implement initial positioning as described by C. Zschalig."] },
-	       "fca"    { "rules"    [ "Think about and write some code." ],
-			  "association-rules" [ "More?" ],
-			  "exploration" [ "Add background knowledge (implications or clauses)." ],
-			  "contexts" [ "Better implementation for context-for-clop." ] },
-	       "gui"    { "plugins"  { "contexteditor" [ "Design and implement." ],
-				       "latticeeditor" [ "Design and implement." ],
-				       "codeeditor"    [ "Design and implement." ],
-				       "browser"       [ "Design and implement graphical plugin browser." ] } },
-	       "contrib" { "fuzzy"   [ "Design and implement something for FuzzyFCA (Cynthia)." ],
-			   "rough"   [ "Design and implement something for RoughSets (Christian)." ],
-			   "algorithms" { "concepts"
-					  [ "Check In-Close and add fast Calculations for Luxenburger Bases.",
-					    "Add preconditioned NextClosure.",
-					    "Implement ParallelNextClosure and Krajca-Outrata-Vychodil." ] } },
-	       "tests"  ["Add tests for everything.",
-			 { "fca"  { "contexts" [ "Finish tests." ],
-				    "implications" [ "Finish tests." ] } } ] },
-    "doc"    [ "Add docstrings for namespaces.",
-	       "Add docstrings for all functions.",
-	       "Extend LaTeX-Documentation." ] })
+  {"conexp" ["Add better error reporting and constraint checking.",
+	     "Add docstrings for namespaces.",
+	     "Add docstrings for all functions.",
+	     "Extend LaTeX-Documentation.",
+
+	     {"layout" {"force"    ["Implement force layout with derivations?"],
+			"zschalig" ["Implement initial positioning as described by C. Zschalig."]},
+	      "fca"    {"rules"    ["Think about and write some code."],
+			"association-rules" ["More?"],
+			"exploration" ["Add background knowledge (implications and clauses)."],
+			"contexts" ["Better implementation for context-for-clop."]},
+	      "gui"    {"plugins"  {"contexteditor" ["Design and implement."],
+				    "latticeeditor" ["Design and implement."],
+				    "codeeditor"    ["Design and implement."],
+				    "browser"       ["Design and implement graphical plugin browser."]}},
+	      "contrib" {"fuzzy"   ["Design and implement something for FuzzyFCA (Cynthia)."],
+			 "rough"   ["Design and implement something for RoughSets (Christian)."],
+			 "algorithms" {"concepts"
+				       ["Check In-Close and add fast Calculations for Luxenburger Bases.",
+					"Add preconditioned NextClosure.",
+					"Implement ParallelNextClosure and Krajca-Outrata-Vychodil."]}},
+	      "tests"  ["Add tests for everything.",
+			{"fca"  {"contexts" ["Finish tests."],
+				 "implications" ["Finish tests."]}}]}]})

 (defn- access-todo-list
   "Returns all tasks remaining for given ns, given as sequence of strings."
@@ -49,12 +52,15 @@
 		     (or (not todo-list)
 			 (empty? keys))
 		     todo-list,
+
 		     (vector? todo-list)
-		     (assoc todo-list
-		       (dec (count todo-list))
-		       {(first keys) (runner ((last todo-list)
-					      (first keys))
-					     (rest keys))}),
+		     (let [todo-for-key ((last todo-list) (first keys))]
+		       (if todo-for-key
+			 (assoc todo-list
+			   (dec (count todo-list))
+			   {(first keys) todo-for-key})
+			 (subvec todo-list 0 (dec (count todo-list))))),
+
 		     (map? todo-list)
 		     {(first keys) (runner (todo-list (first keys))
 					   (rest keys))}))]


Made what-is-left? to output more information

also about things todo in higher packages.

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

--- src/conexp/contrib/todo.clj
+++ src/conexp/contrib/todo.clj
@@ -40,16 +40,21 @@
   "Returns all tasks remaining for given ns, given as sequence of strings."
   [ns-as-seq]
   (if (empty? ns-as-seq)
-    nil
+    *conexp-todo-list*
     (let [runner (fn runner [todo-list keys]
-		   (if (or (not todo-list)
-			   (empty? keys))
-		     todo-list
-		     (recur ((if (vector? todo-list)
-			       (last todo-list)
-			       todo-list)
-			     (first keys))
-			    (rest keys))))]
+		   (cond
+		     (or (not todo-list)
+			 (empty? keys))
+		     todo-list,
+		     (vector? todo-list)
+		     (assoc todo-list
+		       (dec (count todo-list))
+		       {(first keys) (runner ((last todo-list)
+					      (first keys))
+					     (rest keys))}),
+		     (map? todo-list)
+		     {(first keys) (runner (todo-list (first keys))
+					   (rest keys))}))]
       (runner *conexp-todo-list* ns-as-seq))))

 (defn- format-output


Enable write on nativestore object copy

Enable write on nativestore object copy

--- src/derive/nativestore.cljs
+++ src/derive/nativestore.cljs
@@ -172,6 +172,8 @@
 (defprotocol IReadOnly
   (-read-only? [_]))

+(declare writeable!)
+
 (deftype Native [^:mutable __ro]
   IReadOnly
   (-read-only? [_] __ro)
@@ -230,19 +232,19 @@

   IAssociative
   (-assoc [native k v]
-    (let [new (goog.object.clone native)]
+    (let [new (writeable! (goog.object.clone native))]
       (aset new (if (keyword? k) (name k) k) v)
       new))

   IMap
   (-dissoc [native k]
-    (let [new (goog.object.clone native)]
+    (let [new (writeable! (goog.object.clone native))]
       (cljs.core/js-delete new (if (keyword? k) (name k) k))
       new))

   ICollection
   (-conj [native [k v]]
-    (let [new (goog.object.clone native)]
+    (let [new (writeable! (goog.object.clone native))]
       (aset new (if (keyword? k) (name k) k) v)
       new)))

@@ -260,6 +262,17 @@
     (set! (.-constructor jsobj) Native)
     ;; TODO: Copy impls?
     ))
+
+(defn native? [native]
+  (= (.-constructor native) Native))
+
+(defn read-only! [native]
+  {:pre [(native? native)]}
+  (set! (.-__ro native) true))
+
+(defn writeable! [native]
+  {:pre [(native? native)]}
+  (set! (.-__ro native) false))

 ;;
 ;; Native object store


_parent prefix and nested-change should be equal to nested-new

--- src/main/clojure/pdok/featured/processor.clj
+++ src/main/clojure/pdok/featured/processor.clj
@@ -96,7 +96,8 @@
     validated))

 (defn- process-nested-change-feature [processor feature]
-  (process-change-feature processor (assoc feature :action :change)))
+  "Nested change is the same a nested new"
+  (process-new-feature processor (assoc feature :action :change)))

 (defn- process-close-feature [{:keys [persistence projectors]} feature]
   (let [validated (->> feature
@@ -149,7 +150,7 @@
 (defn- enrich [[child-collection-key child] parent new-attributes]
   (let [{:keys [dataset collection action id validity]} parent
         child-id (str (java.util.UUID/randomUUID))
-        parent-attributes (prefixed-attributes child-collection-key new-attributes)
+        parent-attributes (prefixed-attributes "_parent" new-attributes)
         enriched (-> (transient child)
                      (assoc! :dataset dataset)
                      (assoc! :parent-collection collection)


Promote algo to top level

Promote algo to top level

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -115,14 +115,12 @@
             [:text {:x 30 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}}
              "(alts! ch (time-out 2000))"]]]])))))

-(defn go-block [data owner {:keys [radius algo font-size]}]
-  (reify
-    om/IInitState
-    (init-state [_]
-      {:label ""})
+(defn go-block [data owner {:keys [radius algo font-size] :as opts}]
+  (reify
+    om/IInitState
+    (init-state [_] {:label ""})
     om/IWillMount
-    (will-mount [_]
-      (algo owner))
+    (will-mount [_] (algo owner opts))
     om/IRender
     (render [_]
       (html
@@ -162,6 +160,43 @@
                                  (recur)
                                  ))}})])]]]]))))

+(defn catch-game
+  [owner {:keys [id slide channel instances position]}]
+  (println "instances is" instances)
+  (go-loop [n 0]
+
+    (om/set-state! owner :label n)
+    (<! channel)
+
+    (println "instances is " (count instances))
+    (let [to (mod (+ id (+ 2 (rand-int (- (count instances) 4))))
+                  (count instances)
+                  )]
+      ;;(println "Instance " id " is playing and sending to" to)
+      ;;(println "From position" position)
+      ;;(println "To position" (:position (get instances to)))
+      (let [from-pos position
+            to-pos (:position (get instances to))
+            xdelta (/ (- (first to-pos) (first from-pos)) 18)
+            ydelta (/ (- (second to-pos) (second from-pos)) 18)
+            ]
+
+        (go-loop [i 0]
+          (<! (timeout 1))
+          ;;(println "show message" x "," y)
+          (om/set-state!
+           slide :message
+           [(+ (first from-pos) (* i xdelta))
+            (+ (second from-pos) (* i ydelta))])
+          (if (= i 18)
+            (do
+              (om/set-state! slide :message nil)
+              (println "to is" to)
+              (>! (get-in instances [to :channel]) "MESSAGE"))
+            (recur (inc i)))
+          )))
+    (recur (inc n))))
+
 (defn catch-game-slide [data owner opts]
   (reify
     om/IInitState
@@ -207,50 +242,16 @@

            ;; Draw the go-blocks
            (let [instances (om/get-state owner :instances)]
-             (for [{:keys [id position channel]} instances]
+             (for [{:keys [id position channel] :as instance} instances]
                (let [[x y] position]
                  [:g {:transform (str "translate(" x "," y ")")}
                   (om/build
                    go-block data
-                   {:opts {:radius (:radius opts)
-                           :font-size (:font-size opts)
-                           ;; Promote this function somewhere
-                           :algo (fn [gb-owner]
-                                   (go-loop [n 0]
-                                     (om/set-state! gb-owner :label n)
-                                     (<! channel)
-
-                                     (let [to (mod (+ id (+ 2 (rand-int (- (count instances) 4))))
-                                                   (count instances)
-                                                   )]
-                                       ;;(println "Instance " id " is playing and sending to" to)
-                                       ;;(println "From position" position)
-                                       ;;(println "To position" (:position (get instances to)))
-                                       (let [from-pos position
-                                             to-pos (:position (get instances to))
-                                             xdelta (/ (- (first to-pos) (first from-pos)) 18)
-                                             ydelta (/ (- (second to-pos) (second from-pos)) 18)
-                                             ]
-
-                                         (go-loop [i 0]
-                                           (<! (timeout 1))
-                                           ;;(println "show message" x "," y)
-                                           (om/set-state!
-                                            owner :message
-                                            [(+ (first from-pos) (* i xdelta))
-                                             (+ (second from-pos) (* i ydelta))])
-                                           (if (= i 18)
-                                             (do
-                                               (om/set-state! owner :message nil)
-                                               (>! (get-in instances [to :channel]) "MESSAGE"))
-                                             (recur (inc i)))
-                                           ))
-                                       )
-
-
-                                     (recur (inc n))
-                                     )
-                                   )}})])))
+                   {:opts (merge {:radius (:radius opts)
+                                  :font-size (:font-size opts)
+                                  :slide owner
+                                  :algo catch-game
+                                  :instances instances} instance)})])))

            (when-let [[x y] (om/get-state owner :message)]
              [:circle {:cx x :cy y :r 10 :fill "yellow" }])


Java should be formatting errors correctly...

--- jvm-runner/src/clojure/codewars/core.clj
+++ jvm-runner/src/clojure/codewars/core.clj
@@ -6,7 +6,6 @@
             [codewars.runners.groovy]
             [codewars.runners.clojure]
             [codewars.runners.java])
-  (:import [java.util.concurrent TimeoutException])
   (:gen-class))

 (defn- flush-out [val]
@@ -14,17 +13,16 @@
   val)

 (defn- fail [e]
-  (binding [*out* *err*]
-    (println (str "<ERROR::>" (.getMessage e) "<:LF:>")))
-  ;(System/exit 1)
-  )
+  (println (str "<ERROR::>" (.getMessage e) "<:LF:>"))
+  (let [sw (java.io.StringWriter.)]
+    (.printStackTrace e (java.io.PrintWriter. sw))
+    (println (str sw)))
+  (System/exit 1))

 (defn -main
   "Listens to *in* for a JSON message, parses it and calls the appropriate runner"
   [& _]
-  (let [ms ((fnil #(Integer/parseInt %)
-                  "5000")
-            (env :timeout))
+  (let [ms ((fnil #(Integer/parseInt %) "5000") (env :timeout))
         input (json/parse-stream *in* true)]
     (try
       (flush-out (with-timeout ms (run input)))


(PDB-5161) engine: handle AST null? operator fields via parse-field

See the comments for some additional information.

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -2473,17 +2473,27 @@
                        value op)))))

             [["null?" column-name value]]
-            (let [maybe-dotted-path (str/split column-name #"\.")
-                  cinfo (get-in query-rec [:projections (first maybe-dotted-path)])]
-
+            ;; For now, this assumes that foo[5] and match(...) are
+            ;; just custom fact names, and doesn't handle foo.5.bar as
+            ;; a foo array access, to maintain backward compatibility,
+            ;; i.e. create-json-path-extraction doesn't do anything
+            ;; but single quote the compoents for a pg json path
+            ;; lookup, e.g. json->'x'->'y'.  If we want null? to work
+            ;; on nested arrays, then we'll need to distinguish,
+            ;; i.e. foo.b'ar[5].baz should become
+            ;; foo->'b''ar'->5->'baz'.
+            ;; cf. https://www.postgresql.org/docs/11/functions-json.html
+            (let [[top & path] (parse/parse-field column-name 0
+                                                  {:indexes? false
+                                                   :matches? false})
+                  cinfo (get-in query-rec [:projections (:name top)])]
               (if (and (= :queryable-json (:type cinfo))
-                       (seq? (rest maybe-dotted-path)))
+                       (seq path))
                 (let [field (name (h/extract-sql (:field cinfo)))
-                      dotted-path (->> maybe-dotted-path rest (str/join "."))
-                      json-path (->> (parse/dotted-query->path dotted-path)
-                                     (map parse/maybe-strip-escaped-quotes ))
-                      path-extraction-field (jdbc/create-json-path-extraction field json-path)]
-                  (map->NullExpression {:column (assoc cinfo :field (hcore/raw path-extraction-field))
+                      json-path (->> (map :name path)
+                                     (jdbc/create-json-path-extraction field)
+                                     hcore/raw)]
+                  (map->NullExpression {:column (assoc cinfo :field json-path)
                                         :null? value}))
                 (map->NullExpression {:column cinfo :null? value})))


--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -2481,17 +2481,27 @@
                        value op)))))

             [["null?" column-name value]]
-            (let [maybe-dotted-path (str/split column-name #"\.")
-                  cinfo (get-in query-rec [:projections (first maybe-dotted-path)])]
-
+            ;; For now, this assumes that foo[5] and match(...) are
+            ;; just custom fact names, and doesn't handle foo.5.bar as
+            ;; a foo array access, to maintain backward compatibility,
+            ;; i.e. create-json-path-extraction doesn't do anything
+            ;; but single quote the compoents for a pg json path
+            ;; lookup, e.g. json->'x'->'y'.  If we want null? to work
+            ;; on nested arrays, then we'll need to distinguish,
+            ;; i.e. foo.b'ar[5].baz should become
+            ;; foo->'b''ar'->5->'baz'.
+            ;; cf. https://www.postgresql.org/docs/11/functions-json.html
+            (let [[top & path] (parse/parse-field column-name 0
+                                                  {:indexes? false
+                                                   :matches? false})
+                  cinfo (get-in query-rec [:projections (:name top)])]
               (if (and (= :queryable-json (:type cinfo))
-                       (seq? (rest maybe-dotted-path)))
+                       (seq path))
                 (let [field (name (h/extract-sql (:field cinfo)))
-                      dotted-path (->> maybe-dotted-path rest (str/join "."))
-                      json-path (->> (parse/dotted-query->path dotted-path)
-                                     (map parse/maybe-strip-escaped-quotes ))
-                      path-extraction-field (jdbc/create-json-path-extraction field json-path)]
-                  (map->NullExpression {:column (assoc cinfo :field (hcore/raw path-extraction-field))
+                      json-path (->> (map :name path)
+                                     (jdbc/create-json-path-extraction field)
+                                     hcore/raw)]
+                  (map->NullExpression {:column (assoc cinfo :field json-path)
                                         :null? value}))
                 (map->NullExpression {:column cinfo :null? value})))


(PDB-3723) Adjust string and bool fact comparisons for jsonb

[rlb@puppet.com: adjust message]

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -1461,10 +1461,11 @@
             [[(op :guard #{"=" "<" ">" "<=" ">="}) "value" (value :guard #(number? %))]]
             ["and" ["=" ["function" "jsonb_typeof" "value"] "number"] [op "value" value]]

-
-            [["=" "value" (value :guard #(or (string? %) (ks/boolean? %)))]]
-            (let [value-column (if (string? value) "value_string" "value_boolean")]
-            ["=" value-column value])
+            [["=" "value" (value :guard #(string? %))]]
+            ["and" ["=" ["function" "jsonb_typeof" "value"] "string"] ["=" "value" value]]
+
+            [["=" "value" (value :guard #(ks/boolean? %))]]
+            ["and" ["=" ["function" "jsonb_typeof" "value"] "boolean"] ["=" "value" value]]

             [[(op :guard #{"=" "~" ">" "<" "<=" ">="}) "value" value]]
             (when (= :facts (get-in (meta node) [:query-context :entity]))


Check if allowed.

Check if allowed.

--- src/onyx/log/commands/volunteer_for_task.clj
+++ src/onyx/log/commands/volunteer_for_task.clj
@@ -62,12 +62,17 @@
        (common/alive-jobs replica)
        (common/jobs-with-available-tasks replica)))

-(defn offer-acker [replica job args]
+(defn allowed-to-be-acker? [replica job task args]
+  (or (some #{task} (:acker-exempt-tasks replica))
+      (some #{task} (get-in replica [:input-tasks job]))
+      (some #{task} (get-in replica [:output-tasks job]))))
+
+(defn offer-acker [replica job task args]
   (let [peers (count (apply concat (vals (get-in replica [:allocations job]))))
         ackers (count (get-in replica [:ackers job]))
         pct (get-in replica [:acker-percentage job])
         current-pct (int (Math/ceil (* 10 (double (/ ackers peers)))))]
-    (if (< current-pct pct)
+    (if (and (< current-pct pct) (allowed-to-be-acker? replica job task args))
       (-> replica
           (update-in [:ackers job] conj (:id args))
           (update-in [:ackers job] vec))
@@ -83,7 +88,7 @@
             (update-in [:allocations job task] conj (:id args))
             (update-in [:allocations job task] vec)
             (assoc-in [:peer-state (:id args)] :warming-up)
-            (offer-acker job args)))
+            (offer-acker job task args)))
       replica)))

 (defmethod select-job :onyx.job-scheduler/round-robin
@@ -99,7 +104,7 @@
               (update-in [:allocations job task] conj (:id args))
               (update-in [:allocations job task] vec)
               (assoc-in [:peer-state (:id args)] :warming-up)
-              (offer-acker job args)))
+              (offer-acker job task args)))
         replica))
     replica))

@@ -123,7 +128,7 @@
             (update-in [:allocations job task] conj (:id args))
             (update-in [:allocations job task] vec)
             (assoc-in [:peer-state (:id args)] :warming-up)
-            (offer-acker job args)))
+            (offer-acker job task args)))
       replica)))

 (defmethod select-job :default


More work on gorilla visualizer.

More work on gorilla visualizer.

--- src/error_codes/gorilla.clj
+++ src/error_codes/gorilla.clj
@@ -2,7 +2,7 @@

 ;; **
 ;;; # Gorilla visualisations for error codes.
-;;;
+;;;
 ;;; Inline views for error codes are a huge help when correcting pages and viewing the changes made by correction algorithms.
 ;; **

@@ -17,7 +17,8 @@
 ;; <=

 ;; @@
-(m/defsegment diff-view
+
+(m/defsegment diff-segment
               {:preamble ["react.js"]
                :optimizations :advanced
                :pretty-print false
@@ -27,6 +28,46 @@
               [om.core :as om :include-macros true]
               [error-codes.visualizer :as v]))
   (enable-console-print!)
+  (def error-css
+  "
+  body {
+  padding-top: 60px;
+  padding-bottom: 40px;
+  }
+  .wrap {
+  width:1000px;
+  margin:0 auto;
+  }
+  .left {
+  float:left;
+  width:500px;
+  }
+  .right{
+  float:right;
+  width:500px;
+  }
+  .summary-div{
+  width:1000px;
+  display:block;
+  }
+  .boxed {
+   border:solid black 1px;
+  }
+  table{
+  border-collapse:collapse;
+  border:1px solid black;
+  }
+  table-div{
+  width:1000px;
+  }
+  table td{
+  border:1px solid black;
+  }
+  ")
+  (let [css (.createElement js/document "style")]
+       (aset css "type" "text/css")
+       (aset css "innerHTML" error-css)
+       (.appendChild (.item (.getElementsByTagName js/document "head") 0) css))
   (defn main []
     (marmoset.client/autoheight)
     (om/root v/page-view
@@ -46,7 +87,7 @@
                 env  {:left left
                       :right right
                       :error-codes error-codes}
-                html (diff-view id env)]
+                html (diff-segment id env)]
             {:type :html
              :value (pr-str self)
              :content html})))


Add wrappers for Sesame Inferencing SAILs

--- src/rdf-repository/grafter/rdf/repository.clj
+++ src/rdf-repository/grafter/rdf/repository.clj
@@ -26,7 +26,8 @@
            (org.openrdf.repository.sparql SPARQLRepository)
            (org.openrdf.sail.memory MemoryStore)
            (org.openrdf.sail.nativerdf NativeStore)
-           (info.aduna.iteration CloseableIteration)))
+           (info.aduna.iteration CloseableIteration)
+           (org.openrdf.sail.inferencer.fc ForwardChainingRDFSInferencer DirectTypeHierarchyInferencer CustomGraphQueryInferencer)))

 (defn- resource-array #^"[Lorg.openrdf.model.Resource;" [& rs]
   (into-array Resource rs))
@@ -144,6 +145,40 @@
   ([query-url update-url]
      (doto (SPARQLRepository. query-url update-url)
        (.initialize))))
+
+(defn rdfs-inferencer
+  "Returns a Sesame ForwardChainingRDFSInferencer using the rules from
+  the RDF Semantics Recommendation (10 February 2004).
+
+  You can instantiate a repository with a memory store or a native
+  store or with any SAIL that returns InferencerConnections.  e.g. to
+  instantiate a repository with a memory-store:
+
+  (repo (rdfs-inferencer (memory-store)))"
+
+  ([]
+   (ForwardChainingRDFSInferencer.))
+  ([notifying-sail]
+   (ForwardChainingRDFSInferencer. notifying-sail)))
+
+(defn direct-type-inferencer
+  "A forward-chaining inferencer that infers the direct-type hierarchy
+  relations sesame:directSubClassOf, sesame:directSubPropertyOf and
+  sesame:directType."
+  ([]
+   (DirectTypeHierarchyInferencer.))
+  ([notifying-sail]
+   (DirectTypeHierarchyInferencer. notifying-sail)))
+
+(defn custom-query-inferencer
+  "A forward-chaining inferencer that infers new statements using a
+  SPARQL graph query."
+  ([]
+   (CustomGraphQueryInferencer.))
+  ([query-text matcher-text]
+   (CustomGraphQueryInferencer. QueryLanguage/SPARQL query-text matcher-text))
+  ([notifying-sail query-text matcher-text]
+   (CustomGraphQueryInferencer. notifying-sail QueryLanguage/SPARQL query-text matcher-text)))

 (defn repo
   "Given a sesame Store of some type, return a sesame SailRepository."


Fix benchmark function in tests for 0.2 API

--- src/test/clojure/clojure/data/json_test.clj
+++ src/test/clojure/clojure/data/json_test.clj
@@ -279,6 +279,6 @@
 (defn benchmark []
   (dotimes [_ 8]
     (time
-     (dotimes [_ 100]
-       (assert (= (json/read-str pass1-string false)
-                  (json/read-str (json/write-str (json/read-str pass1-string false)) false)))))))
+     (dotimes [_ 1000]
+       (assert (= (json/read-str pass1-string)
+                  (json/read-str (json/write-str (json/read-str pass1-string)))))))))


Delete redundant :use calls

Delete redundant :use calls

--- src/app/interactive.clj
+++ src/app/interactive.clj
@@ -1,10 +1,10 @@
 (ns app.interactive
-  (:use [app.model.protocols])
-  (:use [app.model.javaparser])
-  (:use [app.javaparser.navigation])
-  (:use [app.operations])
-  (:use [app.itemsOnLifecycle])
-  (:use [app.utils])
+  (:use [app.model.protocols]
+        [app.model.javaparser]
+        [app.javaparser.navigation]
+        [app.operations]
+        [app.itemsOnLifecycle]
+        [app.utils])
   (:require [instaparse.core :as insta])
   (:import [app.operations Operation]))


Can make sidebar use functions instead of content when clicked

--- src/webapp/framework/client/coreclient.cljs
+++ src/webapp/framework/client/coreclient.cljs
@@ -559,7 +559,12 @@
                                            ;:onclick #(js/alert "fd")
                                            :onmouseover
                                                #(do
-                                                  (swap-section ($ :#main-section) (make-el (:html x)))
+                                                  (cond
+                                                       (:html x)
+                                                            (swap-section ($ :#main-section) (make-el (:html x)))
+                                                       (:fn x)
+                                                            ((:fn x))
+                                                  )
                                                   (js/deactivateLeftSidebarItems)
                                                   (. ($ (find-el (str "left-sidebar-" y))) addClass "active")
                                                 )


use the new templating fns

use the new templating fns

--- src/aspire/handlers.clj
+++ src/aspire/handlers.clj
@@ -1,11 +1,6 @@
 (ns aspire.handlers
   (:require [aspire.templates :as a-tpl]
             [aspire.util :as a-util]))
-
-
-(defn config-key! [ctx]
-  (spit "/tmp/expectorate.txt" (str ctx))
-  "config-key!")

 (def config-page-keys
   ;; List all the config keys we expect to receive from a particular
@@ -20,28 +15,34 @@
      (when (some #{key} (page config-page-keys)) true))
    params))

+(defn config-key!
+  "This is intended to be where an AJAX-PUT single config key would be handled."
+  [ctx]
+  (spit "/tmp/expectorate.txt" (str ctx))
+  "This is not implemented yet.")
+
 (defn config-page!
   "Take in a page of configuration updates for the config table.
    Apply the updates to the DB and return the map of results from set-config!."
   [ctx]
   (let [page (get-in ctx [:request :route-params :page])
         params (get-in ctx [:request :form-params])]
-    #_[:params params]
     (map (fn do-config-page! [[k v]]
            (a-util/set-config! (str page "/" k) v))
          (whitelist-config-page-keys (keyword page) params))))

+;; Page handlers
+;; -----------------------
 (defn onboarding! [ctx]
-  (let [header (a-tpl/common-header (rand-int 100) "http://google.com" "Bo Jackson")
+  (let [common-snippets (a-tpl/common-snippets ctx)
         greeting (a-util/get-config! "onboarding/greeting")
         greeting-msg (a-util/get-config! "onboarding/greeting-msg")
-        steps (a-util/split-paragraphs (a-util/get-config! "onboarding/steps"))
-        request (:request ctx)]
-    (a-tpl/render (a-tpl/onboarding header greeting greeting-msg steps))))
+        steps (a-util/split-paragraphs (a-util/get-config! "onboarding/steps"))]
+    (a-tpl/onboarding common-snippets greeting greeting-msg steps)))

-(defn admin! [_]
-  (let [header (a-tpl/common-header (rand-int 100) "http://google.com" "Jo Backson")
+(defn admin! [ctx]
+  (let [common-snippets (a-tpl/common-snippets ctx)
         greeting (a-util/get-config! "onboarding/greeting")
         greeting-msg (a-util/get-config! "onboarding/greeting-msg")
         steps-str (a-util/get-config! "onboarding/steps")]
-    (a-tpl/render (a-tpl/admin header greeting greeting-msg steps-str))))
+    (a-tpl/admin common-snippets greeting greeting-msg steps-str)))


don't fail if shutter isn't present

don't fail if shutter isn't present

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -202,6 +202,10 @@

 (declare device-agents)

+(defn wait-for-device [dev]
+  (when (and dev (pos? (.length dev)))
+    (core waitForDevice dev)))
+
 (defn create-device-agents []
   (def device-agents
     (let [devs (seq (core getLoadedDevices))]
@@ -247,7 +251,7 @@
       (doall (map (partial await-for 10000) (vals device-agents))))
     (do
       (doseq [[dev action] action-map]
-        (action) (core waitForDevice dev)))))
+        (action) (wait-for-device dev)))))

 (defn run-autofocus []
   (.. gui getAutofocusManager getDevice fullFocus)
@@ -257,11 +261,11 @@
   (with-core-setting [getAutoShutter setAutoShutter false]
     (if open-before
       (core setShutterOpen true)
-      (core waitForDevice (core getShutterDevice)))
+      (wait-for-device (core getShutterDevice)))
     (core snapImage)
     (if close-after
       (core setShutterOpen false))
-      (core waitForDevice (core getShutterDevice))))
+      (wait-for-device (core getShutterDevice))))

 (defn init-burst [length]
   (core setAutoShutter (@state :init-auto-shutter))
@@ -315,7 +319,7 @@
             (let [z (compute-z-position event)]
               (when (not= z (@state :last-z-position))
                 (do (set-stage-position z-drive z)
-                    (core waitForDevice z-drive)))))
+                    (wait-for-device z-drive)))))
           #(do (expose event)
                (collect-image event out-queue))))))


Only cleanup when requested to!

Only cleanup when requested to!

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -564,7 +564,8 @@
                  (not (core isContinuousFocusEnabled)))
         (enable-continuous-focus true))
       (. gui enableRoiButtons true))
-    (catch Throwable t (ReportingUtils/showError t "Acquisition cleanup failed."))))
+    (catch Throwable t (do (.printStackTrace t)
+                           (ReportingUtils/showError t "Acquisition cleanup failed.")))))

 ;; running events

@@ -631,7 +632,9 @@
         (.put out-queue TaggedImageQueue/POISON)
         ))
     (catch Throwable t (do (ReportingUtils/showError t "Acquisition failed.")
-                           (cleanup)
+                           (.printStackTrace t)
+                           (when cleanup?
+                             (cleanup))
                            (.put out-queue TaggedImageQueue/POISON)))))

 ;; generic metadata


make sure mmc and gui objects are loaded before anything else runs in acq eng

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -778,7 +778,6 @@
 (defn run-acquisition-with-processors [this settings acq-eng]
   (def last-acq this)
   (def eng acq-eng)
-  (load-mm)
   (swap! (.state this) assoc :stop false :pause false :finished false)
   (let [out-queue (LinkedBlockingQueue. 10)]
     (reset! (.state this) nil)
@@ -798,6 +797,7 @@
   [[] (atom {:stop false})])

 (defn -run [this acq-settings acq-eng]
+  (load-mm)
   (let [settings (convert-settings acq-settings)
         summary-metadata (make-summary-metadata settings)
         out-queue-2 (run-acquisition-with-processors this settings acq-eng)]


cleanup generation

cleanup generation

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -33,6 +33,8 @@
         (cons (rand-nth x) x)
         x)

+      false x
+
       true
       ;; nondeterministic generation
       (lazy-seq (shuffle x)))))
@@ -45,7 +47,6 @@
 (declare lightning-bolts)
 (declare comp-paths)
 (declare gen)
-(declare show-spec)

 (defn generate
   "Return one expression matching spec _spec_ given the model _model_."
@@ -110,12 +111,6 @@
   ;; And so on.
   ;;
   ;;
-  (if (nil? spec)
-    ;;    (throw (Exception. (str "wtf.")))
-    nil
-    (do
-;;    (println (str "gen@" depth "; spec=" (dag_unify.core/strip-refs spec)))
-  (log/trace (str "gen@" depth "; spec=" (show-spec spec)))
   (when (< depth max-depth)
     (let [bolts (or from-bolts
                     (get-bolts-for model spec
@@ -137,7 +132,7 @@
                                  (reverse (comp-paths depth)))))
            (gen spec model depth (rest bolts))))
         (if (not (= false (get-in spec [:phrasal] true)))
-          (gen spec model (+ 1 depth)))))))))
+          (gen spec model (+ 1 depth)))))))

 ;; Wrapper around (defn lightning-bolts) to provide a way to
 ;; test indexing and memoization strategies.
@@ -167,8 +162,7 @@
                         (map #(unify spec %))
                         (filter #(not (= :fail %))))))
       true
-      (do (log/trace (str "no compiled bolts found for: " search-for-key))
-          (lazy-seq (lightning-bolts model spec 0 depth))))))
+      (lightning-bolts model spec 0 depth))))

 ;; a 'lightning bolts' is a dag that
 ;; has among paths, paths like [:head :head :head] and
@@ -224,17 +218,7 @@
                        (assoc-in candidate-parent [:head] head))))
            (lightning-bolts model spec depth max-depth (rest candidate-parents))))
         []))
-    (do
-      (log/debug (str "looking for lexemes with spec:" (dag_unify.core/strip-refs spec)))
-      (let [lexemes (shufflefn (get-lexemes model spec))]
-        (if (empty? lexemes)
-          (log/debug (str "lightning-bolts: no lexemes at depth: " depth
-                          " for spec: " (dag_unify.core/strip-refs spec)))
-          (log/debug (str "lightning-bolts at depth: " depth
-                          " first lexeme:" "'"
-                          ((:morph model) (first lexemes))
-                          "'")))
-        lexemes))))
+    (shufflefn (get-lexemes model spec))))

 (defn add-comps-to-bolt
   "bolt + paths => trees"
@@ -330,20 +314,3 @@
                                "ok."))))
         result)))
    (filter #(not (= :fail %)))))
-
-(defn show-spec [spec]
-  (str "cat=" (get-in spec [:synsem :cat])
-       (if (get-in spec [:rule])
-         (str "; rule=" (strip-refs (get-in spec [:rule]))))
-       (if (not (= (get-in spec [:synsem :agr] ::none) ::none))
-         (str "; agr=" (strip-refs (get-in spec [:synsem :agr]))))
-       (if (not (= (get-in spec [:synsem :sem :pred] ::none) ::none))
-         (str "; pred=" (strip-refs (get-in spec [:synsem :sem :pred]))))
-       (if (get-in spec [:synsem :subcat :1 :cat])
-         (str "; subcat1=" (strip-refs (get-in spec [:synsem :subcat :1 :cat]))))
-       (if (get-in spec [:synsem :subcat :2 :cat])
-         (str "; subcat2=" (strip-refs (get-in spec [:synsem :subcat :2 :cat]))))
-       (if (get-in spec [:synsem :subcat :3 :cat])
-         (str "; subcat3=" (strip-refs (get-in spec [:synsem :subcat :3 :cat]))))
-       (if (not (= (get-in spec [:phrasal] ::none) ::none))
-         (str "; phrasal=" (strip-refs (get-in spec [:phrasal]))))))


DRY up project-image-change event test

DRY up project-image-change event test

--- test-cljs/frontend/analytics/test_track.cljs
+++ test-cljs/frontend/analytics/test_track.cljs
@@ -10,75 +10,33 @@

 (deftest project-image-change-works
   (let [state (analytics-utils/current-state {})
-        event :change-image-clicked]
+        event :change-image-clicked
+        test-image-logging (fn [flag value image-name & [trusty-state-value]]
+                             (bond/with-stub [segment/track-event]
+                               (let [data {:project-id "some-fake-org/some-fake-project"
+                                           :flag flag
+                                           :value value}
+                                     state (if (nil? trusty-state-value)
+                                             state
+                                             (assoc-in state
+                                                       (conj state/feature-flags-path :trusty-beta)
+                                                       trusty-state-value))]
+                                 (controls/post-control-event! "" :project-feature-flag-checked data state state)
+                                 (is (= 1 (-> segment/track-event bond/calls count)))
+                                 (is (analytics-utils/is-correct-arguments?
+                                      (-> segment/track-event bond/calls first :args)
+                                      event
+                                      {:image image-name})))))]
     (testing "switching between precise and trusty with osx off sends the correct event"
-      (bond/with-stub [segment/track-event]
-        (let [data {:project-id "some-fake-org/some-fake-project"
-                    :flag :trusty-beta
-                    :value true}]
-          (controls/post-control-event! "" :project-feature-flag-checked data state state)
-          (is (= 1 (-> segment/track-event bond/calls count)))
-          (is (analytics-utils/is-correct-arguments?
-                (-> segment/track-event bond/calls first :args)
-                event
-                {:image "trusty"}))))
-
-      (bond/with-stub [segment/track-event]
-        (let [data {:project-id "some-fake-org/some-fake-project"
-                    :flag :trusty-beta
-                    :value false}]
-          (controls/post-control-event! "" :project-feature-flag-checked data state state)
-          (is (= 1 (-> segment/track-event bond/calls count)))
-          (is (analytics-utils/is-correct-arguments?
-                (-> segment/track-event bond/calls first :args)
-                event
-                {:image "precise"})))))
+      (test-image-logging :trusty-beta true "trusty")
+      (test-image-logging :trusty-beta false "precise"))

     (testing "switching on osx sets the image to be osx"
-      (bond/with-stub [segment/track-event]
-        (let [data {:project-id "some-fake-org/some-fake-project"
-                    :flag :osx
-                    :value true}]
-          (controls/post-control-event! "" :project-feature-flag-checked data state state)
-          (is (= 1 (-> segment/track-event bond/calls count)))
-          (is (analytics-utils/is-correct-arguments?
-                (-> segment/track-event bond/calls first :args)
-                event
-                {:image "osx"})))))
+      (test-image-logging :osx true "osx"))

     (testing "switching off osx sets it to precise or trusty depending on what is enabled"
-      (bond/with-stub [segment/track-event]
-        (let [data {:project-id "some-fake-org/some-fake-project"
-                    :flag :osx
-                    :value false}
-              state (assoc-in state (conj state/feature-flags-path :trusty-beta) false)]
-          (controls/post-control-event! "" :project-feature-flag-checked data state state)
-          (is (= 1 (-> segment/track-event bond/calls count)))
-          (is (analytics-utils/is-correct-arguments?
-                (-> segment/track-event bond/calls first :args)
-                event
-                {:image "precise"}))))
-
-      (bond/with-stub [segment/track-event]
-        (let [data {:project-id "some-fake-org/some-fake-project"
-                    :flag :osx
-                    :value false}
-              state (assoc-in state (conj state/feature-flags-path :trusty-beta) true)]
-          (controls/post-control-event! "" :project-feature-flag-checked data state state)
-          (is (= 1 (-> segment/track-event bond/calls count)))
-          (is (analytics-utils/is-correct-arguments?
-                (-> segment/track-event bond/calls first :args)
-                event
-                {:image "trusty"})))))
+      (test-image-logging :osx false "trusty" true)
+      (test-image-logging :osx false "precise" false))

     (testing "if there is nothing set in the state and the user turns osx off the image is precise"
-      (bond/with-stub [segment/track-event]
-        (let [data {:project-id "some-fake-org/some-fake-project"
-                   :flag :osx
-                   :value false}]
-        (controls/post-control-event! "" :project-feature-flag-checked data state state)
-        (is (= 1 (-> segment/track-event bond/calls count)))
-        (is (analytics-utils/is-correct-arguments?
-              (-> segment/track-event bond/calls first :args)
-              event
-              {:image "precise"})))))))
+      (test-image-logging :osx false "precise"))))


Attempt to get IgnoreError

Attempt to get IgnoreError

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -8,7 +8,7 @@
             [clojure.math.combinatorics :as c]
             [medley.core :as m]
             [clojure.string :as str])
-  (:import [jnr.ffi LibraryLoader]
+  (:import [jnr.ffi LibraryLoader LibraryOption]
            [jnr.ffi.annotations In Out Pinned LongLong]
            [jnr.ffi.types size_t]))

@@ -237,7 +237,10 @@

 (def ^Sodium sodium
   "The sodium library singleton instance."
-  (.load (LibraryLoader/create Sodium) "sodium"))
+  (->
+   (LibraryLoader/create Sodium)
+   (.option LibraryOption/IgnoreError true)
+   (.load "sodium")))

 (assert (#{0 1} (.sodium_init sodium)))
 ;; TODO When does this get called? Guaranteed from 1 thread?


DRY up the test

DRY up the test

--- test/hu/ssh/github_changelog/semver_test.clj
+++ test/hu/ssh/github_changelog/semver_test.clj
@@ -20,5 +20,7 @@
                    "1.0.1")))

 (deftest newer?
-  (is (semver/newer? (c/complete {:major 1} Semver) (c/complete {:major 0} Semver)))
-  (is (not (semver/newer? (c/complete {:major 0} Semver) (c/complete {:major 1} Semver)))))
+  (let [high (c/complete {:major 1} Semver)
+        low (c/complete {:major 0} Semver)]
+    (is (semver/newer? high low))
+    (is (not (semver/newer? low high)))))


Use instance? and check for interface instead of a concrete type.

--- test/dsbdp/test/data_processing_dsl_tests.clj
+++ test/dsbdp/test/data_processing_dsl_tests.clj
@@ -12,7 +12,7 @@
   dsbdp.test.data-processing-dsl-tests
   (:require [clojure.test :refer :all]
             [dsbdp.data-processing-dsl :refer :all])
-  (import (java.util ArrayList HashMap List)))
+  (import (java.util ArrayList HashMap List Map)))

 (def byte-array-test-data
   "We use the byte array representation of a captured UDP packet as byte array test data."
@@ -35,7 +35,7 @@
                                 ['udpDst '(int16 52)]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn byte-array-test-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))

 (deftest byte-array-to-clj-map-test
@@ -78,7 +78,7 @@
                                 ['udpDst '(/ (int16 52) 2)]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn byte-array-test-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))

 (deftest byte-array-to-java-map-with-additional-operation-and-float-type-test
@@ -88,7 +88,7 @@
                                 ['udpDst '(float (/ (int16 52) 65535))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn byte-array-test-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))

 (deftest byte-array-to-java-map-with-additional-operation-and-two-data-values-test
@@ -97,7 +97,7 @@
                         :rules [['quotient '(/ (int16 52) (int16 50))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn byte-array-test-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? HashMap result))
     (is (= expected result))))

@@ -112,7 +112,7 @@
                         :rules [['quotient '(/ (nth 1) (nth 5))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn input-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? HashMap result))
     (is (= expected result))))

 (deftest clojure-list-to-java-map-with-additional-operation-and-two-data-values-test
@@ -122,7 +122,7 @@
                         :rules [['quotient '(/ (nth 1) (nth 5))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn input-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))

 (deftest java-list-to-java-map-with-additional-operation-and-two-data-values-test
@@ -132,7 +132,7 @@
                         :rules [['quotient '(/ (nth 1) (nth 5))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn input-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))

 (deftest clojure-map-to-java-map-with-additional-operation-and-two-data-values-test
@@ -142,7 +142,7 @@
                         :rules [['quotient '(/ (get "x") (get :z))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn input-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))

 (deftest java-map-to-java-map-with-additional-operation-and-two-data-values-test
@@ -152,6 +152,6 @@
                         :rules [['quotient '(/ (get "x") (get :z))]]}
         data-processing-fn (create-data-processing-fn dsl-expression)
         result (data-processing-fn input-data 0)]
-    (is (= HashMap (type result)))
+    (is (instance? Map result))
     (is (= expected result))))


Add try-parse-double.

Add try-parse-double.

--- metlog-common/src/metlog_common/core.clj
+++ metlog-common/src/metlog_common/core.clj
@@ -48,6 +48,15 @@
   ([ str ]
     (try-parse-long str false)))

+(defn try-parse-double
+  ([ str default-value ]
+   (try
+     (Double/parseDouble str)
+     (catch Exception ex
+       default-value)))
+  ([ str ]
+   (try-parse-double str false)))
+
 (defn config-property
   ( [ name ] (config-property name nil))
   ( [ name default ]


Fix merge error

Fix merge error

--- test/puppetlabs/puppetdb/admin_clean_test.clj
+++ test/puppetlabs/puppetdb/admin_clean_test.clj
@@ -143,8 +143,7 @@
           clean (fn [req]
                   (utils/noisy-future
                    (checked-admin-post "cmd" (clean-cmd req)))
-                  (await-a-while after-clean
-                                 default-timeout-ms TimeUnit/MILLISECONDS))]
+                  (await-a-while after-clean))]
       (with-redefs [cli-svc/clean-puppetdb (fn [& args]
                                              (apply orig-clean args)
                                              (await-a-while after-clean))]


(PDB-5484) storage-test/fact-persistence: re-enable keys update test

This was disabled during the move to jsonb
storage (aa59c3f1dc62a582bb37dd4e6e61abd9fd2c8ac6).

--- test/puppetlabs/puppetdb/scf/storage_test.clj
+++ test/puppetlabs/puppetdb/scf/storage_test.clj
@@ -263,22 +263,29 @@
                 (is (= #{"domain" "fqdn"}
                        (set (keys (volatile-facts certname))))))

-              #_(testing "should update existing keys"
+              (testing "should update existing keys"
                 (is (= 1 (count @updates)))
-                (is (some #{{:timestamp (to-timestamp reference-time)
-                             :environment_id 1
-                             :hash "1a4b10a865b8c7b435ec0fe06968fdc62337f57f"
-                             :producer_timestamp (to-timestamp reference-time)
-                             :producer_id 1}}
-                          ;; Again we grab the pertinent non-id bits
-                          (map (fn [itm]
-                                 (-> (second itm)
-                                     (update-in [:hash] sutils/parse-db-hash)))
-                               @updates)))
-                (is (some (fn [update-call]
-                            (and (= :factsets (first update-call))
-                                 (:timestamp (second update-call))))
-                          @updates))))))
+                (let [bytes->hex (fn [bytes]
+                                   (->> bytes
+                                       (map #(format "%02x" (bit-and 0xff %)))
+                                       (apply str)))
+                      expected-ts (to-timestamp reference-time)
+                      [[_ m _params]] @updates]
+                  (is (= {:timestamp expected-ts
+                          :producer_timestamp expected-ts
+                          :environment_id 1
+                          :producer_id 1
+                          :hash "1a4b10a865b8c7b435ec0fe06968fdc62337f57f"
+                          :paths_hash "2b34e4a4e24b4fca5fc154d2700fc2a430c6a1a1"
+                          :stable_hash "33c9461b3b37541edec996529c3f6aba3c2ea0e4"
+                          :stable {:hostname "myhost" :kernel "Linux" :uptime_seconds 3600}
+                          :volatile {:domain "mynewdomain.com" :fqdn "myhost.mynewdomain.com"}}
+                         (-> m
+                             (update :hash sutils/parse-db-hash)
+                             (update :paths_hash bytes->hex)
+                             (update :stable_hash bytes->hex)
+                             (update :stable sutils/parse-db-json)
+                             (update :volatile sutils/parse-db-json)))))))))

         (testing "replacing all new facts"
           (delete-certname-facts! certname)


Rewrote deprecated collection functions in terms of the new ones.

--- src/midje/util/checkers.clj
+++ src/midje/util/checkers.clj
@@ -629,12 +629,7 @@
   "Accepts a map that contains all the keys and values in expected,
    perhaps along with others"
   {:midje/checker true}
-  (fn [actual]
-    (= (merge actual expected) actual)))
-
-(defn- core-array-of-maps-checker [expected actual]
-  (every? (fn [one-expected-map] (some (map-containing one-expected-map) actual))
-          expected))
+  (contains expected))

 (defn- one-level-map-flatten [list-like-thing]
   (if (map? (first list-like-thing))
@@ -648,11 +643,9 @@
    You can call this with either (only-maps-containing {..} {..}) or
    (only-maps-containing [ {..} {..} ])."
   {:midje/checker true}
-  (let [expected (one-level-map-flatten maps-or-maplist)]
-    (fn [actual]
-      (if (= (count actual) (count expected))
-        (core-array-of-maps-checker expected actual)
-        false))))
+  (let [expected (one-level-map-flatten maps-or-maplist)
+        subfunctions (map contains expected)]
+    (just subfunctions :in-any-order)))

 (defn maps-containing [& maps-or-maplist]
   "Each map in the argument(s) contains contains some map in the expected
@@ -661,15 +654,13 @@
    You can call this with either (maps-containing {..} {..}) or
    (maps-containing [ {..} {..} ])."
   {:midje/checker true}
-  (let [expected (one-level-map-flatten maps-or-maplist)]
-    (fn [actual]
-      (if (>= (count actual) (count expected))
-        (core-array-of-maps-checker expected actual)
-        false))))
+  (let [expected (one-level-map-flatten maps-or-maplist)
+        subfunctions (map contains expected)]
+    (contains subfunctions :in-any-order :gaps-ok)))

 (defn in-any-order
-  "Produces matcher that matches sequences without regard to order"
+  "Produces matcher that matches sequences without regard to order.
+   Prefer (just x :in-any-order)."
   {:midje/checker true}
   [expected]
-  (fn [actual]
-    (= (frequencies expected) (frequencies actual))))
+  (just expected :in-any-order))


Cleanup

Cleanup

--- src/clj/marceline/storm/testing/trident_wordcount.clj
+++ src/clj/marceline/storm/testing/trident_wordcount.clj
@@ -1,11 +1,11 @@
 (ns marceline.storm.testing.trident-wordcount
-  (:import [backtype.storm.tuple Values Fields]
-           storm.trident.TridentTopology
-           [storm.trident.operation.builtin MapGet FilterNull Sum Count]
+  (:import storm.trident.TridentTopology
+           [storm.trident.operation.builtin
+            MapGet
+            FilterNull]
            storm.trident.state.StateType
            [storm.trident.testing MemoryMapState$Factory FixedBatchSpout]
-           [backtype.storm LocalDRPC LocalCluster StormSubmitter]
-           [java.util ArrayList List])
+           [backtype.storm LocalDRPC LocalCluster StormSubmitter])
   (:require [marceline.storm.trident :as t]
             [clojure.string :as string :only [join split]])
   (:use [backtype.storm clojure config])
@@ -40,47 +40,49 @@
       (doseq [word words]
         (t/emit-fn coll word)))))

-(defn build-topology [drpc]
-  (let [spout (doto (mk-fixed-batch-spout 3)
-                (.setCycle true))
-        word-state-factory (MemoryMapState$Factory.)
+(defn build-topology [spout drpc]
+  (let [word-state-factory (MemoryMapState$Factory.)
         trident-topology (TridentTopology.)
         word-counts (-> (t/new-stream trident-topology "word-counts" spout)
                         (t/parallelism-hint 16)
                         (t/each ["sentence"]
-                                 split-args
-                                 ["word"])
+                                split-args
+                                ["word"])
                         (t/project ["word"])
                         (t/group-by ["word"])
                         (t/persistent-aggregate word-state-factory
-                                                 ["word"]
-                                                 count-words
-                                                 ["count"])
+                                                ["word"]
+                                                count-words
+                                                ["count"])
                         (t/parallelism-hint 16))
         count-query (-> (t/drpc-stream trident-topology "words" drpc)
                         (t/each ["args"]
-                                 split-args
-                                 ["word"])
+                                split-args
+                                ["word"])
                         (t/project ["word"])
                         (t/group-by ["word"])
                         (t/state-query word-counts
-                                        ["word"]
-                                        (MapGet.)
-                                        ["count"])
+                                       ["word"]
+                                       (MapGet.)
+                                       ["count"])
                         (t/each ["count"] (FilterNull.))
                         (t/aggregate ["count"]
-                                      sum
-                                      ["sum"])
+                                     sum
+                                     ["sum"])
                         (t/debug))]
     trident-topology))

 (defn run-local! []
   (let [cluster (LocalCluster.)
-        local-drpc (LocalDRPC.)]
+        local-drpc (LocalDRPC.)
+        spout (doto (mk-fixed-batch-spout 3)
+                (.setCycle true))]
     (.submitTopology cluster "wordcounter"
                      {}
                      (.build
-                      (build-topology local-drpc)))
+                      (build-topology
+                       spout
+                       local-drpc)))
     (Thread/sleep 10000)
     (.execute local-drpc "words" "cat dog the man jumped")
     (.shutdown cluster)
@@ -91,11 +93,14 @@
         conf {TOPOLOGY-WORKERS 6
               TOPOLOGY-MAX-SPOUT-PENDING 20
               TOPOLOGY-MESSAGE-TIMEOUT-SECS 60
-              TOPOLOGY-STATS-SAMPLE-RATE 1.00}]
+              TOPOLOGY-STATS-SAMPLE-RATE 1.00}
+        spout (doto (mk-fixed-batch-spout 3)
+                (.setCycle true))]
     (StormSubmitter/submitTopology
      name
      conf
      (.build (build-topology
+              spout
               nil)))))

 (defn -main


Fix TTL conflict

Fix TTL conflict

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -16,6 +16,10 @@
      (QueryBuilder/bindMarker))
   ([name]
      (QueryBuilder/bindMarker name)))
+
+(defn timestamp
+  [column-name]
+  (QueryBuilder/timestamp column-name))

 (defn token
   [& column-names]
@@ -71,29 +75,29 @@
      :<  lt
      <   lt
      :<= lte
-     <=  lte}))
-
-(defprotocol WhereBuilder
-  (build-where [construct query-builder]))
-
-(extend-protocol WhereBuilder
-  clojure.lang.IPersistentVector
-  (build-where [construct ^Select$Where query-builder]
-    (reduce
-     (fn [^Select$Where builder [query-type column value]]
-       (if-let [eq-type (query-type-map query-type)]
-         (.and builder ((query-type-map query-type) (name column) value))
-         (throw (IllegalArgumentException. (str query-type " is not a valid Clause")))
-         ))
-     query-builder
-     construct))
-  clojure.lang.IPersistentMap
-  (build-where [construct ^Select$Where query-builder]
-    (reduce
-     (fn [^Select$Where builder [column value]]
-       (.and builder (eq (name column) value)))
-     query-builder
-     construct)))
+     <=  lte})
+
+  (defprotocol WhereBuilder
+    (build-where [construct query-builder]))
+
+  (extend-protocol WhereBuilder
+    clojure.lang.IPersistentVector
+    (build-where [construct ^Select$Where query-builder]
+      (reduce
+       (fn [^Select$Where builder [query-type column value]]
+         (if-let [eq-type (query-type-map query-type)]
+           (.and builder ((query-type-map query-type) (name column) value))
+           (throw (IllegalArgumentException. (str query-type " is not a valid Clause")))
+           ))
+       query-builder
+       construct))
+    clojure.lang.IPersistentMap
+    (build-where [construct ^Select$Where query-builder]
+      (reduce
+       (fn [^Select$Where builder [column value]]
+         (.and builder (eq (name column) value)))
+       query-builder
+       construct))))

 ;;
@@ -105,7 +109,7 @@
   (fn writetime-query [query-builder]
     (.writeTime query-builder (name column))))

-(defn ttl
+(defn ttl-column
   [column]
   (fn ttl-query [query-builder]
     (.ttl query-builder (name column))))


Add only-if

Add only-if

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -206,7 +206,10 @@
   [m]
   [:where
    (fn where-query [query-builder]
-     (build-where m (.where query-builder)))])
+     (let [query-builder (.where query-builder)]
+       (doseq [clause (to-clauses m)]
+         (.and query-builder clause))
+       query-builder))])

 (defn order-by
   [& orderings]
@@ -391,8 +394,8 @@
     (QueryBuilder/remove column-name value)))

 (defn remove-all-tail
-  [column-name]
-  (fn [values]
+  [values]
+  (fn [column-name]
     (QueryBuilder/removeAll column-name values)))

 (defn put-value
@@ -417,17 +420,33 @@
     (set-column- (name k) v))
   )

-
+(defn only-if
+  [m]
+  [:only-if
+   (fn only-if-query [query-builder]
+     (let [[first & more] (to-clauses m)
+           query-builder  (.onlyIf query-builder first)]
+       (doseq [current more]
+         (.and query-builder current))
+       query-builder)
+
+
+     )])

 (defn- update-records-statement
   [m]
-  [:values (fn update-records-statement-inner [query-builder]
-             (let [first-pair    (first m)
-                   more-pairs    (rest m)
-                   query-builder (.with query-builder (make-assignment first-pair))]
-               (doseq [kvp more-pairs]
-                 (.and query-builder (make-assignment kvp)))
-               query-builder))])
+  [:values
+   (if (empty? m)
+     (fn update-records-statement-inner [query-builder]
+       query-builder)
+     (fn update-records-statement-inner [query-builder]
+       (let [first-pair    (first m)
+             more-pairs    (rest m)
+             query-builder (.with query-builder (make-assignment first-pair))]
+         (doseq [kvp more-pairs]
+           (.and query-builder (make-assignment kvp)))
+         query-builder))
+     )])

 (defn update
   [table-name records & statements]


(PDB-3272) Test fact value reduplication migration

--- test/puppetlabs/puppetdb/scf/migrate_test.clj
+++ test/puppetlabs/puppetdb/scf/migrate_test.clj
@@ -1,5 +1,6 @@
 (ns puppetlabs.puppetdb.scf.migrate-test
-  (:require [puppetlabs.puppetdb.scf.hash :as hash]
+  (:require [clojure.set :as set]
+            [puppetlabs.puppetdb.scf.hash :as hash]
             [puppetlabs.puppetdb.scf.migrate :as migrate]
             [puppetlabs.puppetdb.scf.storage :as store]
             [puppetlabs.kitchensink.core :as kitchensink]
@@ -645,3 +646,185 @@
                  :column_default nil,
                  :numeric_scale nil}}}
               (set (:table-diff schema-diff))))))))
+
+(deftest fact-values-reduplication-schema-diff
+  ;; This does not check the value_string trgm index since it is
+  ;; created opportunistically later in trgm-indexes!
+  (clear-db-for-testing!)
+  (fast-forward-to-migration! 55)
+  (let [initial (schema-info-map *db*)]
+    (apply-migration-for-testing! 56)
+    (let [migrated (schema-info-map *db*)
+          rename-idx (fn [smap idx-id new-table new-name]
+                       (let [idxs (:indexes smap)
+                             idx-info (get idxs idx-id)
+                             new-info (assoc idx-info
+                                             :table new-table
+                                             :index new-name)
+                             new-id (assoc idx-id 0 new-table)]
+                         (assert idx-info)
+                         (update smap :indexes
+                                 #(-> %
+                                      (dissoc idx-id)
+                                      (assoc new-id new-info)))))
+          move-col (fn [smap idx-id new-table]
+                     (let [idxs (:tables smap)
+                           idx-info (get idxs idx-id)
+                           new-info (assoc idx-info
+                                           :table_name new-table)
+                           new-id (assoc idx-id 0 new-table)]
+                       (assert idx-info)
+                       (update smap :tables
+                               #(-> %
+                                    (dissoc idx-id)
+                                    (assoc new-id new-info)))))
+          exp-smap (-> initial
+                       (rename-idx ["fact_values" ["value_integer"]]
+                                   "facts" "facts_value_integer_idx")
+                       (rename-idx ["fact_values" ["value_float"]]
+                                   "facts" "facts_value_float_idx")
+                       (move-col ["fact_values" "value_type_id"] "facts")
+                       (move-col ["fact_values" "value"] "facts")
+                       (move-col ["fact_values" "value_boolean"] "facts")
+                       (move-col ["fact_values" "value_integer"] "facts")
+                       (move-col ["fact_values" "value_float"] "facts")
+                       (move-col ["fact_values" "value_string"] "facts"))
+          diff (-> (diff-schema-maps exp-smap migrated)
+                   (update :index-diff set)
+                   (update :table-diff set))
+          exp-idx-diffs #{ ;; removed indexes
+                          {:left-only
+                           {:schema "public"
+                            :table "fact_values"
+                            :index "fact_values_pkey"
+                            :index_keys ["id"]
+                            :type "btree"
+                            :unique? true
+                            :functional? false
+                            :is_partial false
+                            :primary? true
+                            :user "pdb_test"}
+                           :right-only nil
+                           :same nil}
+                          {:left-only
+                           {:schema "public"
+                            :table "facts"
+                            :index "facts_fact_value_id_idx"
+                            :index_keys ["fact_value_id"]
+                            :type "btree"
+                            :unique? false
+                            :functional? false
+                            :is_partial false
+                            :primary? false
+                            :user "pdb_test"}
+                           :right-only nil
+                           :same nil}
+                          {:left-only
+                           {:schema "public"
+                            :table "fact_values"
+                            :index "fact_values_value_hash_key"
+                            :index_keys ["value_hash"]
+                            :type "btree"
+                            :unique? true
+                            :functional? false
+                            :is_partial false
+                            :primary? false
+                            :user "pdb_test"}
+                           :right-only nil
+                           :same nil}
+                          ;; new indexes
+                          {:left-only nil
+                           :right-only
+                           {:schema "public"
+                            :table "facts"
+                            :index "facts_factset_id_idx"
+                            :index_keys ["factset_id"]
+                            :type "btree"
+                            :unique? false
+                            :functional? false
+                            :is_partial false
+                            :primary? false
+                            :user "pdb_test"}
+                           :same nil}
+                          {:left-only
+                           {:schema "public"
+                            :table "facts"
+                            :index "facts_factset_id_fact_path_id_fact_key"
+                            :index_keys ["factset_id" "fact_path_id"]
+                            :type "btree"
+                            :unique? true
+                            :functional? false
+                            :is_partial false
+                            :primary? false
+                            :user "pdb_test"}
+                           :right-only nil
+                           :same nil}}
+          exp-table-diffs  #{ ;; removed columns
+                             {:left-only
+                              {:numeric_scale nil
+                               :column_default nil
+                               :character_octet_length nil
+                               :datetime_precision nil
+                               :nullable? "NO"
+                               :character_maximum_length nil
+                               :numeric_precision nil
+                               :numeric_precision_radix nil
+                               :data_type "bytea"
+                               :column_name "value_hash"
+                               :table_name "fact_values"}
+                              :right-only nil
+                              :same nil}
+                             {:left-only
+                              {:numeric_scale 0
+                               :column_default nil
+                               :character_octet_length nil
+                               :datetime_precision nil
+                               :nullable? "NO"
+                               :character_maximum_length nil
+                               :numeric_precision 64
+                               :numeric_precision_radix 2
+                               :data_type "bigint"
+                               :column_name "fact_value_id"
+                               :table_name "facts"}
+                              :right-only nil
+                              :same nil}
+                             {:left-only
+                              {:numeric_scale 0
+                               :column_default "nextval('fact_values_id_seq'::regclass)"
+                               :character_octet_length nil
+                               :datetime_precision nil
+                               :nullable? "NO"
+                               :character_maximum_length nil
+                               :numeric_precision 64
+                               :numeric_precision_radix 2
+                               :data_type "bigint"
+                               :column_name "id"
+                               :table_name "fact_values"}
+                              :right-only nil
+                              :same nil}
+                             ;; new columns
+                             {:left-only nil
+                              :right-only
+                              {:numeric_scale nil
+                               :column_default nil
+                               :character_octet_length nil
+                               :datetime_precision nil
+                               :nullable? "YES"
+                               :character_maximum_length nil
+                               :numeric_precision nil
+                               :numeric_precision_radix nil
+                               :data_type "bytea"
+                               :column_name "large_value_hash"
+                               :table_name "facts"}
+                              :same nil}}
+          expected {:index-diff exp-idx-diffs
+                    :table-diff exp-table-diffs}]
+      ;; Handy when trying to see what's wrong.
+      (when-not (= expected diff)
+        (let [unex (-> diff
+                       (update :index-diff set/difference exp-idx-diffs)
+                       (update :table-diff set/difference exp-table-diffs))]
+          (binding [*out* *err*]
+            (println "Unexpected differences:")
+            (clojure.pprint/pprint unex))))
+      (is (= expected diff)))))


fix bug in tb303 - found now that the arg checking for the out ugen is working correctly :-)

--- src/overtone/inst/synth.clj
+++ src/overtone/inst/synth.clj
@@ -29,7 +29,7 @@
                                (lf-tri (second freqs))])]
         selector   (select wave (apply + waves))
         filt       (rlpf selector fil-cutoff r)]
-    filter))
+    filt))

 (definst mooger
   [note 60 amp 0.8


Use p/mappend instead of m/mappend removing unnecesary call forwarding.

--- src/cats/monad/maybe.cljc
+++ src/cats/monad/maybe.cljc
@@ -167,11 +167,12 @@
   maybe-monad
   (reify
     p/Semigroup
-    (mappend [_ mv mv']
+    (mappend [ctx mv mv']
       (cond
         (nothing? mv) mv'
         (nothing? mv') mv
-        :else (just (m/mappend (p/extract mv)
+        :else (just (p/mappend ctx
+                               (p/extract mv)
                                (p/extract mv')))))

     p/Monoid


Fix function invocation

Fix function invocation

--- src/chameleon/crawler.clj
+++ src/chameleon/crawler.clj
@@ -37,7 +37,7 @@
   (mc/upsert db/db
              "samples"
              (create-query-document user-map)
-             (create-sample-document)
+             (create-sample-document user-map)
              {:upsert true}))

 (defn update-users! [user-maps]


protocols are types too

protocols are types too

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -405,6 +405,7 @@
     (let [var (resolve-var env t)]
       (or (:type var)
           (-> var :info :type)
+          (:protocol-symbol var)
           ;; need to hard code some cases because of
           ;; forward declaration - David
           ('#{cljs.core/PersistentHashMap


fix field closure

fix field closure

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -131,9 +131,11 @@
     (when-not (= :expr (:context env)) (print ";\n"))))

 (defn emit-fn-method
-  [{:keys [name variadic params statements ret env recurs]}]
+  [{:keys [gthis name variadic params statements ret env recurs]}]
   (emit-wrap env
              (print (str "(function " name "(" (comma-sep params) "){\n"))
+             (when gthis
+               (println (str "var " gthis " = this;")))
              (when variadic
                (println (str (last params) " = Array.prototype.slice.call(arguments, " (dec (count params)) ");")))
              (when recurs (print "while(true){\n"))
@@ -305,12 +307,13 @@
         variadic (some '#{&} params)
         params (remove '#{&} params)
         body (next meth)
-        locals (reduce (fn [m fld] (assoc m fld {:name (symbol (str "this." (munge fld)))})) locals fields)
+        gthis (and fields (gensym "this__"))
+        locals (reduce (fn [m fld] (assoc m fld {:name (symbol (str gthis "." (munge fld)))})) locals fields)
         locals (reduce (fn [m name] (assoc m name {:name (munge name)})) locals params)
         recur-frame {:names (vec (map munge params)) :flag (atom nil)}
         block (binding [*recur-frame* recur-frame]
                 (analyze-block (assoc env :context :return :locals locals) body))]
-    (merge {:env env :variadic variadic :params (map munge params) :recurs @(:flag recur-frame)} block)))
+    (merge {:env env :variadic variadic :params (map munge params) :gthis gthis :recurs @(:flag recur-frame)} block)))

 (defmethod parse 'fn*
   [op env [_ & args] name]
@@ -605,6 +608,9 @@
 (in-ns 'cljs.core)
 ;;hack on core

+
+(deftype Foo [a] IMeta (-meta [_] (fn [] a)))
+((-meta (Foo. 42)))

 ;;OLD way, don't you want to use the REPL?
 (in-ns 'cljs.compiler)


Reformatted some bad tab characters.

Reformatted some bad tab characters.

--- src/cljode/views/main.clj
+++ src/cljode/views/main.clj
@@ -63,9 +63,9 @@

 (defn build-snippet-links []
     [:div.snippets
-	    [:ul.items
-	      (for [title (snippet/titles)]
-	        [:li (link-to (snippet/edit-url (key title)) (val title))])]])
+      [:ul.items
+        (for [title (snippet/titles)]
+        [:li (link-to (snippet/edit-url (key title)) (val title))])]])

 (defn build-header []
   [:h1 "Cljode"])
@@ -75,12 +75,12 @@
     (build-header)
     (build-snippet-links)
     [:div.float_left
-	    (form-to [:post "/add_snippet"]
-	      [:div.label "title"] (text-field :title title) [:br]
-	      [:div.label "tags"] (text-field :tags tags) [:br]
+      (form-to [:post "/add_snippet"]
+        [:div.label "title"] (text-field :title title) [:br]
+        [:div.label "tags"] (text-field :tags tags) [:br]
         [:div.label "syntax"] (drop-down :syntax syntax-options) [:br]
-	      (text-area {:id "code" :name "code"} :code code) [:br]
-	      (submit-button "add"))]))
+        (text-area {:id "code" :name "code"} :code code) [:br]
+        (submit-button "add"))]))

 (defn edit-snippet [{:keys [id]}]
   (if-let [snippet (snippet/id->snippet id)]
@@ -91,9 +91,9 @@
       (form-to [:post "/edit_snippet"]
         (hidden-field :id id)
         [:div.label "title"] (text-field :title (snippet "title")) [:br]
-	      [:div.label "tags"] (text-field :tags (snippet "tags")) [:br]
+        [:div.label "tags"] (text-field :tags (snippet "tags")) [:br]
         [:div.label "syntax"]  (drop-down :syntax syntax-options (snippet "syntax")) [:br]
-	      [:div.textarea_border (text-area {:id "code" :name "code"} :code (snippet "code"))] [:br]
+        [:div.textarea_border (text-area {:id "code" :name "code"} :code (snippet "code"))] [:br]
         (submit-button "save"))]
         [:script {type "text/javascript"}
           "var editor = CodeMirror.fromTextArea(document.getElementById('code'), {});"])))


Utility for raising edit input events

Utility for raising edit input events

--- src/cljs/gtfve/utils.cljs
+++ src/cljs/gtfve/utils.cljs
@@ -1,4 +1,14 @@
-(ns gtfve.utils)
+(ns gtfve.utils
+  (:require [gtfve.async :refer [raise!]]))
+
+(defn edit-input
+  "Meant to be used in a react event handler, usually for the :on-change event on input.
+  Path is the vector of keys you would pass to assoc-in to change the value in
+  state, event is the Synthetic React event. Pulls the value out of the event.
+  Optionally takes :value as a keyword arg to override the event's value"
+  [owner key event & {:keys [value]
+                      :or {value (.. event -target -value)}}]
+  (raise! owner [:edited-input {:key key :value value}]))

 (defn uuid
   "returns a type 4 random UUID: xxxxxxxx-xxxx-4xxx-yxxx-xxxxxxxxxxxx"