Fix serializer access.

Fix serializer access.

--- src/konserve/filestore.clj
+++ src/konserve/filestore.clj
@@ -516,7 +516,10 @@
                                                          {:type :read-meta-size-error
                                                           :key  key}))
                   (let [[serializer-id compressor-id meta-size] (<?- res-ch)
-                        serializer                              (byte->serializer serializer-id)
+                        ser                              (byte->serializer serializer-id)
+                        serializer                       (if (= (type ser) (type serializer))
+                                                           serializer
+                                                           ser)
                         compressor                              (byte->compressor compressor-id)
                         old                                     (<?- (read-file ac serializer read-handlers (assoc env :compressor compressor) meta-size))]
                     (if (or (= :write-edn operation) (= :write-binary operation))
@@ -593,52 +596,47 @@
                                                                                :key  key}}))
   (-get-meta [this key]
     (io-operation [key] folder serializer read-handlers write-handlers buffer-size {:operation :read-meta
-                                                                                :compressor compressor
-                                                                                :detect-old-files detect-old-version
-                                                                                :version version
-                                                                                :msg       {:type :read-meta-error
-                                                                                :key  key}}))
-  #_(-get-version [this key]
-    (io-operation [key] folder config serializer read-handlers write-handlers buffer-size {:operation :read-version
-                                                                                :detect-old-files detect-old-version
-                                                                                :version version
-                                                                                :msg       {:type :read-version-error
-                                                                                :key  key}}))
+                                                                                :compressor compressor
+                                                                                :detect-old-files detect-old-version
+                                                                                :version version
+                                                                                :msg       {:type :read-meta-error
+                                                                                :key  key}}))
+
   (-assoc-in [this key-vec meta-up val] (-update-in this key-vec meta-up (fn [_] val) []))

   (-update-in [this key-vec meta-up up-fn args]
     (io-operation key-vec folder serializer read-handlers write-handlers buffer-size {:operation  :write-edn
-                                                                                :compressor compressor
-                                                                                :detect-old-files detect-old-version
-                                                                                :version version
-                                                                                :up-fn      up-fn
-                                                                                :up-fn-args args
-                                                                                :up-fn-meta meta-up
-                                                                                :config     config
-                                                                                :msg        {:type :write-edn-error
-                                                                                :key  (first key-vec)}}))
+                                                                                :compressor compressor
+                                                                                :detect-old-files detect-old-version
+                                                                                :version version
+                                                                                :up-fn      up-fn
+                                                                                :up-fn-args args
+                                                                                :up-fn-meta meta-up
+                                                                                :config     config
+                                                                                :msg        {:type :write-edn-error
+                                                                                :key  (first key-vec)}}))
   (-dissoc [this key]
     (delete-file key folder))
   PBinaryAsyncKeyValueStore
   (-bget [this key locked-cb]
     (io-operation [key] folder serializer read-handlers write-handlers buffer-size {:operation :read-binary
-                                                                                :detect-old-files detect-old-version
-                                                                                :compressor compressor
-                                                                                :config    config
-                                                                                :version version
-                                                                                :locked-cb locked-cb
-                                                                                :msg       {:type :read-binary-error
-                                                                                :key  key}}))
+                                                                                :detect-old-files detect-old-version
+                                                                                :compressor compressor
+                                                                                :config    config
+                                                                                :version version
+                                                                                :locked-cb locked-cb
+                                                                                :msg       {:type :read-binary-error
+                                                                                :key  key}}))
   (-bassoc [this key meta-up input]
     (io-operation [key] folder serializer read-handlers write-handlers buffer-size {:operation  :write-binary
-                                                                                :detect-old-files detect-old-version
-                                                                                :compressor compressor
-                                                                                :input      input
-                                                                                :version version
-                                                                                :up-fn-meta meta-up
-                                                                                :config     config
-                                                                                :msg        {:type :write-binary-error
-                                                                                :key  key}}))
+                                                                                :detect-old-files detect-old-version
+                                                                                :compressor compressor
+                                                                                :input      input
+                                                                                :version version
+                                                                                :up-fn-meta meta-up
+                                                                                :config     config
+                                                                                :msg        {:type :write-binary-error
+                                                                                :key  key}}))
   PKeyIterable
   (-keys [this]
     (list-keys folder serializer read-handlers write-handlers buffer-size {:operation :read-meta


issue with bound variables (a let effect)


disable unreliable partial test

disable unreliable partial test

--- test/joda_time/partial_test.clj
+++ test/joda_time/partial_test.clj
@@ -18,7 +18,14 @@
                                      :chronology (.getChronology part)))
                    part)))

-(defspec map-of-merged-partials-same-as-merged-maps 100
+;; This doesn't hold true in some cases:
+
+;; user=> (j/merge (j/local-date-time 0 2 29) (j/year-month 1 3))
+;; #<Partial [year=1, monthOfYear=3, dayOfMonth=28, millisOfDay=0]>)
+
+;; user=> (j/partial (apply merge (map j/as-map [(j/local-date-time 0 2 29) (j/year-month 1 3)])))
+;; #<Partial [year=1, monthOfYear=3, dayOfMonth=29, millisOfDay=0]>)
+#_(defspec map-of-merged-partials-same-as-merged-maps 100
   (prop/for-all [partials (gen/not-empty (gen/vector jg/any-partial))]
                 (try
                   (= (apply j/merge partials)


migration to add titles to issue docs

migration to add titles to issue docs

--- src/pc/datomic/migrations.clj
+++ src/pc/datomic/migrations.clj
@@ -160,6 +160,17 @@
                      {:db/id :access-grant/token
                       :db/unique :db.unique/value
                       :db.alter/_attribute :db.part/db}]))
+
+(defn add-titles-to-issue-docs [conn]
+  (let [db (d/db conn)
+        issues-and-docs (filter #(= "Untitled" (:document/name (:doc %)))
+                                (map (fn [d]
+                                       {:doc (d/entity db (:v d))
+                                        :issue (d/entity db (:e d))})
+                                     (d/datoms db :aevt :issue/document)))]
+    @(d/transact conn (map (fn [{:keys [doc issue]}]
+                             [:db/add (:db/id doc) :document/name (:issue/title issue)])
+                           issues-and-docs))))

 (def migrations
   "Array-map of migrations, the migration version is the key in the map.
@@ -177,7 +188,8 @@
    9 #'add-prcrsr-bot-color
    10 #'add-team-plans
    11 #'ensure-team-creators
-   12 #'add-access-grant-indexes))
+   12 #'add-access-grant-indexes
+   13 #'add-titles-to-issue-docs))

 (defn necessary-migrations
   "Returns tuples of migrations that need to be run, e.g. [[0 #'migration-one]]"


CMR-1436 Adds nREPL to search-app.

CMR-1436 Adds nREPL to search-app.

--- search-app/src/cmr/search/system.clj
+++ search-app/src/cmr/search/system.clj
@@ -1,6 +1,7 @@
 (ns cmr.search.system
   (:require [cmr.common.lifecycle :as lifecycle]
             [cmr.common.log :as log :refer (debug info warn error)]
+            [cmr.common.nrepl :as nrepl]
             [cmr.common.api.web-server :as web]
             [cmr.common.cache :as cache]
             [cmr.common.cache.in-memory-cache :as mem-cache]
@@ -40,6 +41,11 @@
   {:default 3003
    :type Long})

+(defconfig search-nrepl-port
+  "Port to listen for nREPL connections"
+  {:default nil
+   :parser cfg/maybe-long})
+
 (def search-public-conf
   {:protocol (search-public-protocol)
    :host (search-public-host)
@@ -49,7 +55,7 @@
 (def
   ^{:doc "Defines the order to start the components."
     :private true}
-  component-order [:log :caches :search-index :scheduler :web])
+  component-order [:log :caches :search-index :scheduler :web :nrepl])

 (def system-holder
   "Required for jobs"
@@ -67,6 +73,7 @@
              :metadata-db metadata-db
              :search-index (idx/create-elastic-search-index (es-config/elastic-config))
              :web (web/create-web-server (transmit-config/search-port) routes/make-api)
+             :nrepl (nrepl/create-nrepl-if-configured (search-nrepl-port))
              ;; Caches added to this list must be explicitly cleared in query-service/clear-cache
              :caches {idx/index-cache-name (mem-cache/create-in-memory-cache)
                       af/acl-cache-key (af/create-acl-cache


Version clojure du bot CSB

Version clojure du bot CSB

--- clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
+++ clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
@@ -1,11 +1,7 @@
-(ns coders-strike-back.core
+(ns Player
   (:gen-class))

-(def checkpoint-core-size 50)
-(def max-loop-before-boost 3)
-(def max-loop-before-shield 10)
-(def pod-radius 400)
-(def checkpoint-radius 600)
+(def checkpoint-core-size 100)

 (defn inc-atom [curr-val] (inc curr-val))
 (defn dec-atom [curr-val] (dec curr-val))
@@ -36,12 +32,11 @@
 (defn after [val1 val2] (if (> (- val2 val1) 0) true false))
 (defn before [val1 val2] (if (< (- val2 val1) 0) true false))

-;;Compute a thrust value between 0 and 100
-(defn compute-thrust [next-checkpoint-distance next-checkpoint-angle]
+;;Compute a boost value between 0 and 100
+(defn compute-boost [next-checkpoint-distance next-checkpoint-angle]
   (cond
     (> (Math/abs next-checkpoint-angle) 90) "0"
-    (and (< next-checkpoint-distance 1000) (> (Math/abs next-checkpoint-angle) 25)) "0"
-    ; (and (< next-checkpoint-distance 1000) (< (Math/abs next-checkpoint-angle) 30)) "50"
+    (and (< next-checkpoint-distance 1000) (> (Math/abs next-checkpoint-angle) 30)) "0"
     ; (< (Math/abs next-checkpoint-angle) 30) "100"
     ; (> next-checkpoint-distance 4000) "100"
     true "100"))
@@ -67,15 +62,11 @@
 (def game-loop-counter (atom 0))

 ;;Compute BOOST, SHIELD or boost value between 0 and 100
-(defn compute-action [next-checkpoint-x next-checkpoint-y next-checkpoint-distance next-checkpoint-angle opponent-x opponent-y x y boost-used? game-loop-counter]
-      (cond
-       (and
-        (not @boost-used?)
-        (> @game-loop-counter max-loop-before-boost)
-        (< (Math/abs next-checkpoint-angle) 10)
-        (> next-checkpoint-distance 4000)) (do (reset! boost-used? true) "BOOST")
-       ;(and (> @game-loop-counter max-loop-before-shield) (<= (distance x y opponent-x opponent-y) (+ (* 2 pod-radius) 50))) "SHIELD"
-       true (compute-thrust next-checkpoint-distance next-checkpoint-angle)))
+(defn compute-action [next-checkpoint-x next-checkpoint-y next-checkpoint-distance next-checkpoint-angle opponent-x opponent-y boost-used? game-loop-counter]
+      (if (and (not @boost-used?) (> @game-loop-counter 3) (< (Math/abs next-checkpoint-angle) 10) (> next-checkpoint-distance 4000))
+          (do (reset! boost-used? true)
+              "BOOST")
+          (compute-boost next-checkpoint-distance next-checkpoint-angle)))

 (defn -main [& args]
       (while true
@@ -118,6 +109,5 @@
                            nextCheckpointX nextCheckpointY
                            nextCheckpointDist nextCheckpointAngle
                            opponentX opponentY
-                           x y
                            boost-used? game-loop-counter)))
         (println "")))


allow Field.fk_target_field_id to be updated when a field is updated and add in some checks and logic to make sure it's set to proper values.

--- src/metabase/api/field.clj
+++ src/metabase/api/field.clj
@@ -32,19 +32,29 @@

 (defendpoint PUT "/:id"
   "Update `Field` with ID."
-  [id :as {{:keys [special_type visibility_type description display_name]} :body}]
+  [id :as {{:keys [special_type visibility_type fk_target_field_id description display_name], :as body} :body}]
   {special_type    FieldSpecialType
    visibility_type FieldVisibilityType
    display_name    NonEmptyString}
   (let-404 [field (Field id)]
     (write-check field)
-    (let [special_type    (or special_type (:special_type field))
-          visibility_type (or visibility_type (:visibility_type field))]
+    (let [special_type       (or special_type (:special_type field))
+          visibility_type    (or visibility_type (:visibility_type field))
+          fk_target_field_id (when (= :fk special_type)
+                               ;; only let target field be set for :fk type fields,
+                               ;; and if it's not in the payload then leave the current value
+                               (if (contains? body :fk_target_field_id)
+                                 fk_target_field_id
+                                 (:fk_target_field_id field)))]
       (check-400 (field/valid-metadata? (:base_type field) (:field_type field) special_type visibility_type))
+      ;; validate that fk_target_field_id is a valid Field within the same database as our field
+      (when fk_target_field_id
+        (checkp (exists? Field :id fk_target_field_id) :fk_target_field_id "Invalid target field"))
       ;; update the Field.  start with keys that may be set to NULL then conditionally add other keys if they have values
-      (check-500 (m/mapply upd Field id (merge {:description     description
-                                                :special_type    special_type
-                                                :visibility_type visibility_type}
+      (check-500 (m/mapply upd Field id (merge {:description        description
+                                                :special_type       special_type
+                                                :visibility_type    visibility_type
+                                                :fk_target_field_id fk_target_field_id}
                                                (when display_name {:display_name display_name}))))
       (Field id))))


thru rm_case_reporters

thru rm_case_reporters

--- src/pg_demo/table_defs.clj
+++ src/pg_demo/table_defs.clj
@@ -2219,6 +2219,62 @@
               PRIMARY KEY (ENTERPRISE_ID,CASE_ID,SEQ_NUM,DLP_REVISION_NUMBER)
           ); " }

+    { "rm_case_reporters"
+          "CREATE TABLE rm_case_reporters (
+              ENTERPRISE_ID numeric NOT NULL,
+              CASE_ID numeric NOT NULL,
+              SEQ_NUM numeric NOT NULL,
+              MEDIA_ID numeric,
+              OCCUPATION_ID numeric,
+              HCP_FLAG numeric,
+              PRIMARY_CONTACT numeric,
+              CORR_CONTACT numeric,
+              REPORTER_TYPE numeric,
+              INTERMEDIARY_ID numeric,
+              RPT_SENT numeric,
+              SORT_ID numeric,
+              CONFIDENTIAL numeric(1),
+              COUNTRY_ID numeric,
+              SUFFIX varchar(15),
+              MIDDLE_NAME varchar(15),
+              PREFIX varchar(50),
+              FIRST_NAME varchar(35),
+              LAST_NAME varchar(50),
+              REPORTER_ID varchar(20),
+              INSTITUTION varchar(60),
+              DEPARTMENT varchar(60),
+              CITY varchar(35),
+              STATE varchar(40),
+              POSTCODE varchar(15),
+              COUNTRY varchar(50),
+              PHONE varchar(20),
+              ALTPHONE varchar(20),
+              FAX varchar(50),
+              REPORTER_REF varchar(20),
+              EMAIL varchar(100),
+              ADDRESS varchar(120),
+              SUFFIX_J varchar(15),
+              ADDRESS_J varchar(120),
+              CITY_J varchar(35),
+              DEPARTMENT_J varchar(60),
+              FIRST_NAME_J varchar(35),
+              INSTITUTION_J varchar(60),
+              LAST_NAME_J varchar(50),
+              MIDDLE_NAME_J varchar(15),
+              PREFIX_J varchar(50),
+              STATE_J varchar(40),
+              DELETED timestamp,
+              DLP_REVISION_NUMBER numeric NOT NULL,
+              REVISION_DELETE_FLAG numeric,
+              DELETED_FLAG numeric(1) NOT NULL,
+              EFFECTIVE_START_DATE timestamp NOT NULL,
+              EFFECTIVE_END_DATE timestamp NOT NULL,
+              NOTES text,
+              NOTES_J text,
+              INSTITUTION_ID varchar(15),
+              PRIMARY KEY (ENTERPRISE_ID,CASE_ID,SEQ_NUM,DLP_REVISION_NUMBER)
+          ); " }
+
   ] ))

 (def dummy


better debugging for conv man failures

better debugging for conv man failures

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -384,7 +384,7 @@
                   (generate-report-data! conv-man conv math-tick report-task))
                 (swap! conversations assoc-in [zid :conv] conv)
                 (async/thread
-                  (doseq [[k f] @listeners] (try (f conv) (catch Exception e (log/error "Listener error") (.printStackTrace e)))))
+                  (doseq [[k f] @listeners] (try (f conv) (catch Exception e (log/error e "Listener error")))))
                 (recur conv)))))))))


Add insertions data to inspection for use by tooling.

--- src/main/clojure/clara/tools/inspect.clj
+++ src/main/clojure/clara/tools/inspect.clj
@@ -22,7 +22,8 @@
 (def InspectionSchema
   {:rule-matches {schema/Rule [Explanation]}
    :query-matches {schema/Query [Explanation]}
-   :condition-matches {schema/Condition [s/Any]}})
+   :condition-matches {schema/Condition [s/Any]}
+   :insertions {schema/Rule [{:explanation Explanation :fact s/Any}]}})

 (defn- get-condition-matches
   "Returns facts matching each condition"
@@ -38,6 +39,17 @@
                   concat (map :fact (mem/get-elements-all memory node))))
      {}
      join-nodes)))
+
+
+(defn- to-explanation
+  "Helper function to convert a token to explanation records."
+  [session {:keys [matches bindings] :as token}]
+  (let [id-to-node (get-in (eng/components session) [:rulebase :id-to-node])]
+         (->Explanation
+          ;; Convert matches to explanation structure.
+          (for [[fact node-id] matches]
+            [fact (-> node-id (id-to-node) (:condition))])
+          bindings)))

 (defn- to-explanations
   "Helper function to convert tokens to explanation records."
@@ -59,6 +71,8 @@
    * :rule-matches -- a map of rule structures to their matching explanations.
    * :query-matches -- a map of query structures to their matching explanations.
    * :condition-matches -- a map of conditions pulled from each rule to facts they match.
+   * :insertions -- a map of rules to a sequence of {:explanation E, :fact F} records
+     to allow inspection of why a given fact was inserted.

    Users may inspect the entire structure for troubleshooting or explore it
    for specific cases. For instance, the following code snippet could look
@@ -98,7 +112,13 @@
                                                     (mem/get-tokens-all memory query-node))]))

      :condition-matches (get-condition-matches beta-tree memory)
-     }))
+
+     :insertions (into {}
+                       (for [[rule rule-node] rule-to-nodes]
+                         [rule
+                          (for [token (mem/get-tokens-all memory rule-node)
+                                insertion (mem/get-insertions memory rule-node token)]
+                            {:explanation (to-explanation session token) :fact insertion})]))}))

 (defn explain-activation
   "Prints a human-readable explanation of the facts and conditions that created the Rete token."


added syntactic sugar for hardware enumeration and some abstraction for reference counted udev objects

--- src/main/clojure/com/contentjon/udev.clj
+++ src/main/clojure/com/contentjon/udev.clj
@@ -4,59 +4,71 @@

 (def library (com.sun.jna.Native/loadLibrary "udev" UDev))

-(Native/setProtected true)
+(defprotocol ReferenceCounted
+  (add-ref [_])
+  (rem-ref [_]))

-(defmulti add-ref (fn [key obj] key))
-(defmulti unref   (fn [key obj] key))
+(defmacro defreftype
+  ([name]      `(defreftype ~name "" []))
+  ([name type] `(defreftype ~name ~type [~'udev-ref]))
+  ([name type members]
+     (let [ref-symbol   (symbol (str ".udev_" type "_ref"))
+           unref-symbol (symbol (str ".udev_" type "_unref"))]
+       `(defrecord ~name ~(vec (concat ['native] members))
+          Object
+          (finalize [~'this] (rem-ref ~'this))
+          ReferenceCounted
+          (add-ref [_]
+                   (~ref-symbol library ~'native))
+          (rem-ref [_]
+                   (~unref-symbol library ~'native))))))

-(defmethod add-ref :udev [key udev]
-  (.udev_ref library udev))
+(defreftype UDevRef)
+(defreftype EnumerateRef "enumerate")
+(defreftype DeviceRef "device")

-(defmethod add-ref :enum [key enumeration]
-  (.udev_enumerate_ref library enumeration))
+(defn udev-context []
+  (UDevRef. (.udev_new library)))

-(defmethod add-ref :device [key device]
-  (.udev_device_ref library device))
+(defn enum [udev]
+  (EnumerateRef. (.udev_enumerate_new library (:native udev)) udev))

-(defmethod unref :udev [key udev]
-  (.udev_unref library udev))
+(defn device [udev path]
+  (DeviceRef. (.udev_device_new_from_syspath library (:native udev) path) udev))

-(defmethod unref :enum [key enumeration]
-  (.udev_enumerate_unref library enumeration))
-
-(defmethod unref :device [key device]
-  (.udev_device_unref library device))
-
-(defn garbage-collected-ref [key obj]
-  (add-ref key obj)
-  (reify Object
-    (finalize [_] (unref key obj))))
-
-(defmacro with-ref [key bind & forms]
-  `(let ~bind
-     (try
-       ~@forms
-       (finally
-         (unref ~key ~(bind 0))))))
-
-(defn- udev-seq [entry collector]
+(defn- udev-seq [entry ref]
   (lazy-seq
     (when-not (= Pointer/NULL entry)
-      (let [name  (.udev_list_entry_get_name  library entry)
+      (let [name  (.udev_list_entry_get_name  library entry)
             value (.udev_list_entry_get_value library entry)
-            next  (.udev_list_entry_get_next  library entry)]
-        (cons [name value] (udev-seq next collector))))))
+            next  (.udev_list_entry_get_next  library entry)]
+        (cons [name value] (udev-seq next ref))))))

 (defn- enum-seq [enumeration]
   (udev-seq
-    (.udev_enumerate_get_list_entry library enumeration)
-    (garbage-collected-ref :enum enumeration)))
+    (.udev_enumerate_get_list_entry library (:native enumeration))
+    enumeration))

 (defn scan [enumeration]
-  (.udev_enumerate_scan_devices library enumeration)
+  (.udev_enumerate_scan_devices library (:native enumeration))
   (map first (enum-seq enumeration)))

 (defn in-class [enumeration & classes]
   (doseq [clazz classes]
-    (.udev_enumerate_add_match_subsystem library enumeration clazz))
+    (.udev_enumerate_add_match_subsystem library (:native enumeration) clazz))
   enumeration)
+
+(defn has-attribute
+  ([enumeration attribute]
+     (has-attribute enumeration attribute Pointer/NULL))
+  ([enumeration attribute value]
+     (.udev_enumerate_add_match_sysattr library (:native enumeration) attribute value)
+     enumeration))
+
+(defmacro enumerate-devices [context & queries]
+  `(-> (enum ~context)
+       ~@queries
+       (scan)))
+
+(defn get-attribute [device attribute]
+  (.udev_device_get_sysattr_value library (:native device) attribute))


Change route to /homework6contest

Change route to /homework6contest

--- src/sweng_hw6_grader/core.clj
+++ src/sweng_hw6_grader/core.clj
@@ -1,12 +1,41 @@
 (ns sweng-hw6-grader.core
   (:use [compojure.core :only [defroutes GET]])
   (:require [ring.adapter.jetty :as jetty]
+            [ring.util.response :as resp]
             [compojure.handler :as handler]))

+; Some middleware to ignore trailing slashes in URLs
+(defn with-uri-rewrite
+  "Rewrites a request uri with the result of calling f with the
+   request's original uri.  If f returns nil the handler is not called."
+  [handler f]
+  (fn [request]
+    (let [uri (:uri request)
+          rewrite (f uri)]
+      (if rewrite
+        (handler (assoc request :uri rewrite))
+        nil))))
+
+(defn- uri-snip-slash
+  "Removes a trailing slash from all uris except \"/\"."
+  [uri]
+  (if (and (not (= "/" uri))
+           (.endsWith uri "/"))
+    (subs uri 0 (dec (count uri)))
+    uri))
+
+(defn ignore-trailing-slash
+  "Makes routes match regardless of whether or not a uri ends in a slash."
+  [handler]
+  (with-uri-rewrite handler uri-snip-slash))
+
 (defroutes routes
-  (GET "/" [] "
SwEng 2013 HW6 Contest

Coming soon...
"))
+  (GET "/" [] (resp/redirect "/homework6contest"))
+  (GET "/homework6contest" [] "
SwEng 2013 HW6 Contest

Coming soon...
"))

-(def application (handler/site routes))
+(def application
+  (-> (handler/site routes)
+      ignore-trailing-slash))

 (defn start [port]
   (jetty/run-jetty application {:port port


fix compilation error when releasing

fix compilation error when releasing

--- src/shuppet/urlbuilder.clj
+++ src/shuppet/urlbuilder.clj
@@ -43,7 +43,7 @@
    "Timestamp" (current-time)
    "SignatureMethod" hmac-sha256-algorithm})

-(defn- bytes
+(defn- to-bytes
   [str]
   (.getBytes str "UTF-8"))

@@ -53,7 +53,7 @@

 (defn- get-mac
   []
-  (let [signing-key (SecretKeySpec. (bytes (aws-secret)) hmac-sha256-algorithm)
+  (let [signing-key (SecretKeySpec. (to-bytes (aws-secret)) hmac-sha256-algorithm)
         mac (Mac/getInstance hmac-sha256-algorithm)]
     (.init mac signing-key)
     mac))
@@ -63,7 +63,7 @@
 (defn- calculate-hmac
   [data]
   (try
-    (let [raw-mac (.doFinal @mac-obj (bytes data))]
+    (let [raw-mac (.doFinal @mac-obj (to-bytes data))]
       (base64 raw-mac))
     (catch Exception e
       (log/error e "Failed to generate HMAC"))))


Handled retrieving image for streaming responses

--- src/video_server/metadata.clj
+++ src/video_server/metadata.clj
@@ -26,8 +26,8 @@

 (defn retrieve-image
   "Returns the image as a byte array."
-  ^bytes [url]
-  (let [resp (client/get url {:as :byte-array})]
+  ^java.io.InputStream [url]
+  (let [resp (client/get url {:as :stream})]
     (when (= (:status resp) 200)
       (:body resp))))

@@ -81,11 +81,12 @@
   "Downloads the poster for the specified video."
   [title url & [overwrite]]
   (let [file (io/file (title-dir title) (adjust-filename (norm-title (:title title)) (file-ext url)))]
-    (when (or overwrite (not (.exists file)))
+    (when (or overwrite (not (.exists file)) (zero? (.length file)))
       (log/info "downloading poster for" (:title title))
-      (when-let [contents (retrieve-image url)]
-        (with-open [w (io/output-stream file)]
-          (.write w contents))))))
+      (when-let [stream (retrieve-image url)]
+        (with-open [r stream]
+          (with-open [w (io/output-stream file)]
+           (io/copy r w)))))))

 (defn title-parts
   "Extracts the year from the title to aid in metadata lookup."


Remove shape-type struct validator.

Remove shape-type struct validator.

--- src/uxbox/util/schema.cljs
+++ src/uxbox/util/schema.cljs
@@ -8,8 +8,7 @@
 (ns uxbox.util.schema
   (:refer-clojure :exclude [keyword uuid vector boolean map set])
   (:require [struct.core :as st]
-            [uxbox.util.i18n :refer (tr)]
-            [uxbox.main.geom :refer (shape?)]))
+            [uxbox.util.i18n :refer (tr)]))

 ;; (def datetime
 ;;   {:message "must be an instant"
@@ -65,11 +64,6 @@
    :optional true
    :validate #(not (nil? (re-find #"^#[0-9A-Fa-f]{6}$" %)))})

-(def shape-type
-  {:message "should be shape"
-   :optional true
-   :validate #(shape? %)})
-
 (defn validate
   ([data schema]
    (validate data schema nil))


Add Office validations to v5 validations

--- src/vip/data_processor/validation/v5.clj
+++ src/vip/data_processor/validation/v5.clj
@@ -11,7 +11,8 @@
             [vip.data-processor.validation.v5.election-administration :as election-admin]
             [vip.data-processor.validation.v5.election :as election]
             [vip.data-processor.validation.v5.locality :as locality]
-            [vip.data-processor.validation.v5.internationalized-text :as intl-text]))
+            [vip.data-processor.validation.v5.internationalized-text :as intl-text]
+            [vip.data-processor.validation.v5.office :as office]))

 (def validations
   [candidate/validate-no-missing-ballot-names
@@ -41,4 +42,7 @@
    locality/validate-no-missing-names
    locality/validate-no-missing-state-ids
    locality/validate-types
-   intl-text/validate-no-missing-texts])
+   intl-text/validate-no-missing-texts
+   office/validate-no-missing-names
+   office/validate-no-missing-term-types
+   office/validate-term-types])


CMR-6287: PR comments

CMR-6287: PR comments

--- system-int-test/test/cmr/system_int_test/search/autocomplete/suggestion_reindex_test.clj
+++ system-int-test/test/cmr/system_int_test/search/autocomplete/suggestion_reindex_test.clj
@@ -18,6 +18,21 @@
                       [(ingest/reset-fixture {"provguid1" "PROV1"})
                        hu/grant-all-humanizers-fixture
                        hu/save-sample-humanizers-fixture]))
+
+(defn compare-autocomplete-results
+ "Compare expected to actual response for the following:
+ - Items are ordered by score in descending order
+ - Ensure that the other fields match"
+ [actual expected]
+ (let [scores (map :score actual)
+       actual-scores-descending? (->> actual
+                                      (map :score)
+                                      (apply >=))
+       ; we don't need to actually compare scores
+       expected (map #(dissoc % :score) expected)
+       actual (map #(dissoc % :score) actual)]
+   (is (true? actual-scores-descending?))
+   (is (= expected actual))))

 (def sk1 (umm-spec-common/science-keyword {:Category "Earth science"
                                            :Topic "Topic1"
@@ -84,17 +99,20 @@
     (index/reindex-suggestions)
     (index/wait-until-indexed)
     (testing "Ensure that response is in proper format and results are correct"
-      (is (= (get-in (search/get-autocomplete-json "q=level2") [:feed :entry])
-            [{:score 0.25604635 :type "organization" :value "Langley DAAC User Services" :fields "Langley DAAC User Services"}
-             {:score 0.041718055 :type "instrument" :value "lVIs" :fields "lVIs"}])))
+      (compare-autocomplete-results
+        (get-in (search/get-autocomplete-json "q=level2") [:feed :entry])
+        [{:score 0.25604635 :type "organization" :value "Langley DAAC User Services" :fields "Langley DAAC User Services"}
+         {:score 0.041718055 :type "instrument" :value "lVIs" :fields "lVIs"}]))
     (testing "Ensure science keywords are being indexed properly"
-        (is (= (get-in (search/get-autocomplete-json "q=solar") [:feed :entry])
-               [{:score 3.4995544, :type "science_keywords", :value "Solar Irradiance", :fields "Sun-Earth Interactions:Solar Activity:Solar Irradiance"}
-                {:score 1.9641972, :type "science_keywords", :value "Solar Irradiance", :fields "Atmosphere:Atmospheric Radiation:Solar Irradiance"}
-                {:score 0.20964509, :type "organization", :value "ACRIM SCF", :fields "ACRIM SCF"}
-                {:score 0.16771607, :type "organization", :value "Langley DAAC User Services", :fields "Langley DAAC User Services"}]))
-        (is (= (get-in (search/get-autocomplete-json "q=solar irradiation") [:feed :entry])
-               [{:score 5.0869484, :type "science_keywords", :value "Solar Irradiance", :fields "Sun-Earth Interactions:Solar Activity:Solar Irradiance"}
-                {:score 2.7943783, :type "science_keywords", :value "Solar Irradiance", :fields "Atmosphere:Atmospheric Radiation:Solar Irradiance"}
-                {:score 0.061936468, :type "organization", :value "ACRIM SCF", :fields "ACRIM SCF"}
-                {:score 0.049549174, :type "organization", :value "Langley DAAC User Services", :fields "Langley DAAC User Services"}])))))
+        (compare-autocomplete-results
+         (get-in (search/get-autocomplete-json "q=solar") [:feed :entry])
+         [{:score 3.4995544, :type "science_keywords", :value "Solar Irradiance", :fields "Sun-Earth Interactions:Solar Activity:Solar Irradiance"}
+          {:score 1.9641972, :type "science_keywords", :value "Solar Irradiance", :fields "Atmosphere:Atmospheric Radiation:Solar Irradiance"}
+          {:score 0.20964509, :type "organization", :value "ACRIM SCF", :fields "ACRIM SCF"}
+          {:score 0.16771607, :type "organization", :value "Langley DAAC User Services", :fields "Langley DAAC User Services"}])
+        (compare-autocomplete-results
+         (get-in (search/get-autocomplete-json "q=solar irradiation") [:feed :entry])
+         [{:score 5.0869484, :type "science_keywords", :value "Solar Irradiance", :fields "Sun-Earth Interactions:Solar Activity:Solar Irradiance"}
+          {:score 2.7943783, :type "science_keywords", :value "Solar Irradiance", :fields "Atmosphere:Atmospheric Radiation:Solar Irradiance"}
+          {:score 0.061936468, :type "organization", :value "ACRIM SCF", :fields "ACRIM SCF"}
+          {:score 0.049549174, :type "organization", :value "Langley DAAC User Services", :fields "Langley DAAC User Services"}]))))


[SD CS] Only run setup-postgres once

[SD CS] Only run setup-postgres once

Deleting and recreating the test database will fail if there are open
connections to the database, which happens after tests start running.
This fixture only needs to be run once, not once per namespace. So we
keep a little bit of state to ensure that.

--- test/vip/data_processor/test_helpers.clj
+++ test/vip/data_processor/test_helpers.clj
@@ -61,29 +61,36 @@
           (is (sequential? errors))
           (is (not (empty? errors))))))))

+(defonce setup-postgres-has-run (atom false))
+
 (defn setup-postgres
-  "A :once test fixture to drop and create the test database."
+  "A :once test fixture to drop and create the test database. This can only be
+  run once due to an undiagnosed connection leakage"
   [f]
-  (log/info "Recreating the test database")
-  (let [database-name (config :postgres :database)
-        jdbc-config {:dbtype "postgresql"
-                     :dbname ""  ; do not connect to a db for creating/dropping
-                     :host (config :postgres :host)
-                     :port (config :postgres :port)
-                     :user (config :postgres :user)
-                     :password (config :postgres :password)}]
-    (jdbc/execute! jdbc-config [(str "DROP DATABASE IF EXISTS " database-name)] :transaction? false)
-    (jdbc/execute! jdbc-config [(str "CREATE DATABASE " database-name)] :transaction? false)
-    (psql/initialize)
-    ;; these vars will be unbound until after psql/initialize, so
-    ;; don't set psql-tables until after that's been run
-    (def psql-tables [psql/xml-tree-validations
-                      psql/xml-tree-values
-                      psql/election_approvals
-                      psql/statistics
-                      psql/validations
-                      psql/results])
-    (f)))
+  (when-not @setup-postgres-has-run
+    (log/info "Recreating the test database")
+    (let [database-name (config :postgres :database)
+          jdbc-config {:dbtype "postgresql"
+                       :dbname ""  ; do not connect to a db for creating/dropping
+                       :host (config :postgres :host)
+                       :port (config :postgres :port)
+                       :user (config :postgres :user)
+                       :password (config :postgres :password)}]
+
+      (jdbc/execute! jdbc-config [(str "DROP DATABASE IF EXISTS " database-name)] :transaction? false)
+      (jdbc/execute! jdbc-config [(str "CREATE DATABASE " database-name)] :transaction? false)
+
+      (psql/initialize)
+      ;; these vars will be unbound until after psql/initialize, so
+      ;; don't set psql-tables until after that's been run
+      (def psql-tables [psql/xml-tree-validations
+                        psql/xml-tree-values
+                        psql/election_approvals
+                        psql/statistics
+                        psql/validations
+                        psql/results])
+      (reset! setup-postgres-has-run true)))
+  (f))

 (defn with-clean-postgres
   "An :each test fixture to clear out tables in the test database. "


remove receivedate and remarks validation

--- src_cljs/rrm/corecljs.cljs
+++ src_cljs/rrm/corecljs.cljs
@@ -34,7 +34,7 @@
                           :is-searched-results false
                           :user nil}))

-(def serverhost "http://localhost:9000/")
+(def serverhost "http://192.168.0.114:9000/")

 (defn set-key-value [k v]
   (reset! storage (assoc @storage k v)))
@@ -345,8 +345,9 @@
                      :o4number [[v/required :message "Field is required"]]
                      :o6number [[v/required :message "Field is required"]]
                      :racknumber [[v/required :message "Field is required"]]
-                     :receiveddate [[v/required :message "Field is required"]]
-                     :remarks [[v/required :message "Field is required"]])))
+                     ;; :receiveddate [[v/required :message "Field is required"]]
+                     ;; :remarks [[v/required :message "Field is required"]]
+                     )))

 (defn form-input-element [id label ttype data-set focus]
   (let [input-focus (r/atom nil)]


bug fix

bug fix

removed the * as there is only one hop to get to GeneSpecificGorGPClass

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/abstraction/abstraction_extending_rules.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/abstraction/abstraction_extending_rules.clj
@@ -11,7 +11,7 @@

   :body
   ((?/gene rdf/type kbio/GeneSpecificGClass)
-   (?/gene [rdfs/subClassOf clojure.core/*] ?/gorgp)
+   (?/gene rdfs/subClassOf ?/gorgp)
    (?/gorgp rdf/type kbio/GeneSpecificGorGPClass)

    (?/r1 owl/someValuesFrom ?/gene)


fix init state not being set

fix init state not being set

--- app/core.cljs
+++ app/core.cljs
@@ -70,7 +70,7 @@
           (let [new-app-state (plumbing/for-map
                                 [[k v] (:data res)]
                                 k
-                                (if (keyword? v)
+                                (if (string? v)
                                   (keyword v)
                                   v))]
             (log/fine l new-app-state)


Update references to fingerprinted assets in sources

--- src/afrey/boot_asset_fingerprint.clj
+++ src/afrey/boot_asset_fingerprint.clj
@@ -57,7 +57,15 @@
                                        :skip?       skip
                                        :asset-host  asset-host
                                        :file-hashes file-rename-hash})
-                  (spit out-file $))))
+                  (do
+                    (spit out-file $)
+                    (when-let [fingerprinted-out-file (some->> (and (not skip) file)
+                                                               (:path)
+                                                               (get file-rename-hash)
+                                                               (io/file output-dir))]
+                      (doto fingerprinted-out-file
+                        (io/make-parents)
+                        (spit $)))))))

             (when (not skip)
               (doseq [file (->> fileset
@@ -66,7 +74,8 @@
                       :let [out-file (->> file
                                        (:path)
                                        (get file-rename-hash)
-                                       (io/file output-dir))]]
+                                       (io/file output-dir))]
+                      :when (not (contains? (set (map :path sources)) (:path file)))]
                 (do
                   (io/make-parents out-file)
                   (io/copy (core/tmp-file file) out-file))))))


Force render before calling on-can-play

Force render before calling on-can-play

--- src/asciinema/player/processing.cljs
+++ src/asciinema/player/processing.cljs
@@ -3,7 +3,8 @@
             [asciinema.player.util :as util]
             [asciinema.player.messages :as m]
             [asciinema.player.frames :as f]
-            [asciinema.player.source :as source]))
+            [asciinema.player.source :as source]
+            [reagent.core :as reagent]))

 ;;; UI originated messages

@@ -80,6 +81,7 @@
   m/TriggerCanPlay
   (update-player [this {:keys [on-can-play] :as player}]
     (when on-can-play
+      (reagent/flush)
       (on-can-play))
     player)


lock when logging

lock when logging

--- src/bzzz/log.clj
+++ src/bzzz/log.clj
@@ -1,20 +1,26 @@
 (ns bzzz.log)
 (def level* (atom 1))
+(def lock (Object.))
+
+(defn do-log [min-level args]
+  (when (>= @level* min-level)
+    (locking lock
+      (println "<" min-level ">" args))))

 (defn fatal [& args]
-  (when (>= @level* 0) (println args)))
+  (do-log 0 args))

 (defn error [& args]
-  (when (>= @level* 0) (println args)))
+  (do-log 0 args))

 (defn warn [& args]
-  (when (>= @level* 1) (println args)))
+  (do-log 1 args))

 (defn info [& args]
-  (when (>= @level* 2) (println args)))
+  (do-log 2 args))

 (defn debug [& args]
-  (when (>= @level* 3) (println args)))
+  (do-log 3 args))

 (defn trace [& args]
-  (when (>= @level* 4) (println args)))
+  (do-log 4 args))


update io handling

update io handling

--- src/cljs/ws_ldn_2/day1/ui/state.cljs
+++ src/cljs/ws_ldn_2/day1/ui/state.cljs
@@ -40,7 +40,7 @@
   []
   (->> {:spec (:query @app-state) :format "png"}
        (io/->request-data)
-       (str "/queryviz?")
+       (str "http://localhost:8000/queryviz?")
        (set-state! :query-viz-uri)))

 (defn init-map


express negated tags in search with leading tilde, e.g. ~#test

--- iwaswhere-web/src/cljs/iwaswhere_web/helpers.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/helpers.cljs
@@ -18,10 +18,12 @@

 (defn parse-entry
   "Parses entry for hashtags and mentions. Either can consist of any of the word characters, dashes
-  and unicode characters that for example comprise German 'Umlaute'."
+  and unicode characters that for example comprise German 'Umlaute'.
+  The negative lookahead (?!`) makes sure that tags and mentions are not found and processed
+  when they are quoted as code with backticks."
   [text]
-  (let [tags (set (re-seq (js/RegExp. (str "(?!^)#" tag-char-class "+(?!" tag-char-class ")") "m") text))
-        mentions (set (re-seq (js/RegExp. (str "@" tag-char-class "+(?!" tag-char-class ")") "m") text))]
+  (let [tags (set (re-seq (js/RegExp. (str "(?!^)#" tag-char-class "+(?!" tag-char-class ")(?!`)") "m") text))
+        mentions (set (re-seq (js/RegExp. (str "@" tag-char-class "+(?!" tag-char-class ")(?!`)") "m") text))]
     {:md        text
      :tags      tags
      :mentions  mentions}))
@@ -42,8 +44,8 @@
   in either the entry or any of its comments, can be found like this: #task #~done"
   [text]
   {:search-text text
-   :tags        (set (re-seq (js/RegExp. (str "#" tag-char-class "+") "m") text))
-   :not-tags    (set (re-seq (js/RegExp. (str "#~" tag-char-class "+") "m") text))
+   :tags        (set (map second (re-seq (js/RegExp. (str "(?:^|[^~])(#" tag-char-class "+)") "m") text)))
+   :not-tags    (set (re-seq (js/RegExp. (str "~#" tag-char-class "+") "m") text))
    :mentions    (set (re-seq (js/RegExp. (str "@" tag-char-class "+") "m") text))
    :date-string (re-find #"[0-9]{4}-[0-9]{2}-[0-9]{2}" text)
    :timestamp   (re-find #"[0-9]{13}" text)})


Add docstring

Add docstring

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -581,6 +581,20 @@
    :meta {}})

 (deftask static
+  "Render an individual page solely from a render function
+
+   The symbol supplied as `renderer` should resolve to a function
+   which will be called with a map containing the following keys:
+    - `:meta`, global perun metadata
+    - `:entry`, the entry to be rendered
+
+   Entries can optionally be filtered by supplying a function
+   to the `filterer` option.
+
+   Filename is determined as follows:
+   If permalink is set for the file, it is used as the filepath.
+   If permalink ends in slash, index.html is used as filename.
+   If permalink is not set, the original filename is used with file extension set to html."
   [o out-dir  OUTDIR   str "the output directory"
    r renderer RENDERER sym "page renderer (fully qualified symbol resolving to a function)"
    p page     PAGE     str "static result page path"


Exclude `:include-rss` and `:include-atom` from original content file metadata

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -152,8 +152,12 @@
                                                        :full-path :mime-type :original))]
                                  (perun/create-file tmp page-filepath parsed)
                                  entry)))
+            input-metadata* (map #(-> %
+                                      (dissoc :include-rss)
+                                      (dissoc :include-atom))
+                                 input-metadata)
             final-metadata (perun/merge-meta* (perun/get-meta @prev-fs)
-                                              (concat input-metadata output-metadata))
+                                              (concat input-metadata* output-metadata))
             new-fs (-> fileset
                        (commit tmp)
                        (perun/set-meta final-metadata))]


rename :target options to :out-dir

rename :target options to :out-dir

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -138,11 +138,11 @@
         (commit fileset tmp)))))

 (def ^:private +render-defaults+
-  {:target "public"})
+  {:out-dir "public"})

 (deftask render
   "Render pages"
-  [o target   OUTDIR   str  "The output directory"
+  [o out-dir  OUTDIR   str  "The output directory"
    r renderer RENDERER code "Page renderer"]
   (let [tmp (boot/tmp-dir!)
         options (merge +render-defaults+ *opts*)]
@@ -151,7 +151,7 @@
         (doseq [file files]
           (let [render-fn (:renderer options)
                 html (render-fn file)
-                page-filepath (str (:target options) "/"
+                page-filepath (str (:out-dir options) "/"
                                    (or (:filepath file)
                                        (str (:filename file) ".html")))]
             (perun/create-file tmp page-filepath html)))
@@ -159,14 +159,14 @@
         (commit fileset tmp)))))

 (def ^:private +collection-defaults+
-  {:target "public"
+  {:out-dir "public"
    :filterer identity
    :sortby (fn [file] (:date-published file))
    :comparator (fn [i1 i2] (compare i1 i2))})

 (deftask collection
   "Render collection files"
-  [o target     OUTDIR     str  "The output directory"
+  [o out-dir    OUTDIR     str  "The output directory"
    r renderer   RENDERER   code "Page renderer"
    f filterer   FILTER     code "Filter function"
    s sortby     SORTBY     code "Sort by function"
@@ -180,7 +180,7 @@
             sorted-files (sort-by (:sortby options) (:comparator options) filtered-files)
             render-fn (:renderer options)
             html (render-fn sorted-files)
-            page-filepath (str (:target options) "/" page)]
+            page-filepath (str (:out-dir options) "/" page)]
         (perun/create-file tmp page-filepath html)
         (u/info (str "Render collection " page "\n"))
         (commit fileset tmp)))))


Fixed parens position in ns :require

Fixed parens position in ns :require

--- src/leiningen/new/figwheel/core.cljs
+++ src/leiningen/new/figwheel/core.cljs
@@ -1,9 +1,8 @@
 (ns {{name}}.core
-    (:require [figwheel.client :as fw] {{#om?}}
+    (:require [figwheel.client :as fw]{{#om?}}
               [om.core :as om :include-macros true]
-              [om.dom :as dom :include-macros true] {{/om?}} {{#reagent?}}
-              [reagent.core :as reagent :refer [atom]] {{/reagent?}}
-              ))
+              [om.dom :as dom :include-macros true]{{/om?}}{{#reagent?}}
+              [reagent.core :as reagent :refer [atom]]{{/reagent?}}))

 (enable-console-print!)


Show stack traces in production.

Show stack traces in production.


documentation

documentation

--- src/shoutout.clj
+++ src/shoutout.clj
@@ -8,7 +8,10 @@
     (.update crc (.getBytes s))
     (.getValue crc)))

-(defn split [raw pattern]
+(defn split
+  "splits strings using clojure.string/split, but doesn't return [\"\"] when
+  splitting an empty string"
+  [raw pattern]
   (if (empty? raw)
     []
     (s/split raw pattern)))
@@ -21,7 +24,9 @@
     0
     (Integer/parseInt raw)))

-(defn parse-feature [^String feature-name ^String raw]
+(defn parse-feature
+  "turns a feature name and serialized feature into an feature"
+  [^String feature-name ^String raw]
   (let [[raw-percentage raw-users raw-groups]
         (split raw #"\|")]
     (Feature. feature-name
@@ -29,7 +34,9 @@
               (into #{} (split raw-users  #","))
               (parse-percentage raw-percentage))))

-(defn serialize-feature [^Feature feature]
+(defn serialize-feature
+  "turns a feature into a serialized feature, ready for storage"
+  [^Feature feature]
   (str
     (:percentage feature)
     "|"
@@ -50,7 +57,11 @@

     active-groups))

-(defn active-feature? [feature group-definition user]
+(defn active-feature?
+  "works out if a user is active in a feature, by checking percentages, if
+  they're specifically marked as active, or if they're in a group that is
+  active"
+  [feature group-definition user]
   (or
     (is-active-in-percentage feature user)
     (is-active-user? feature user)
@@ -58,67 +69,101 @@

 ;; imperative shell
 (defprotocol ShoutoutStorage
-  (read-from-storage [storage ^String feature-name])
-  (write-to-storage [storage  ^String feature-name ^String serialized]))
+  "an abstraction over storage for your feature toggles

-(defn get-from-storage [storage feature-name]
+  rough contract: after I put in a feature at feature-name, I should be able to
+  get out a feature at that feature-name at some point in the future
+
+  implementations of this protocol should NOT concern themselves with serialization,
+  they deal with serialized strings only"
+  (read-from-storage
+    [storage ^String feature-name]
+    "read the feature from the supplied storage. should return a raw String,
+    ready to be parsed by parse-feature")
+  (write-to-storage
+    [storage  ^String feature-name ^String serialized]
+    "write a serialized feature to the storage"))
+
+(defn get-from-storage
+  "retrieve a deserialized feature from storage"
+  [storage feature-name]
   (parse-feature feature-name (read-from-storage storage feature-name)))

-(defn with-storage [storage feature-name f]
+(defn with-storage
+  "alter a feature using the supplied function f. handles reading, serializing,
+  deserializing, you just write f to modify the feature as wanted"
+  [storage feature-name f]
   (let [feature (get-from-storage storage feature-name)]
     (write-to-storage storage feature-name (serialize-feature
                                              (f feature)))))

-(defn activate [{storage :storage} feature-name]
+(defn activate
+  "completely activate a feature for all users"
+  [{storage :storage} feature-name]
   (with-storage
     #(assoc %
             :percentage
             100)))

-(defn deactivate [{storage :storage} feature-name]
-  (with-storage
-    #(assoc %
-            :percentage
-            0)))
-
-(defn activate-group [{storage :storage} feature-name group]
+(defn activate-group
+  "activate a feature for a particular group.
+  A group should just be a string"
+  [{storage :storage} feature-name group]
   (with-storage
     (fn [feature]
       (update-in feature
                 :groups
                  #(conj % group)))))

-(defn deactivate-group [{storage :storage} feature-name group]
+(defn deactivate-group
+  "deactivate a feature for a particular group.
+  A group is just a string"
+  [{storage :storage} feature-name group]
   (with-storage
     (fn [feature]
       (update-in feature
                  :groups
                  #(disj % group)))))

-(defn activate-user [{storage :storage} feature-name user]
+(defn activate-user
+  "activate a feature for a particular user"
+  [{storage :storage} feature-name user]
   (with-storage
     (fn [feature]
       (update-in feature
                 :users
                  #(conj % user)))))

-(defn deactivate-user [{storage :storage} feature-name user]
+(defn deactivate-user
+  "deactivate a feature for a particular user"
+  [{storage :storage} feature-name user]
   (with-storage
     (fn [feature]
       (update-in feature
                  :users
                  #(disj % user)))))

-(defn activate-percentage [{storage :storage} feature-name percent]
+(defn activate-percentage
+  "activate a feature for a percentage of users.
+  percentages are out of 100"
+  [{storage :storage} feature-name percent]
   (with-storage
     (fn [feature]
       (assoc feature
              :percentage
              percent))))

-(defn active? [{storage :storage groups :groups} feature-name user]
+(defn active?
+  "check if a particular user is active for a given feature"
+  [{storage :storage groups :groups} feature-name user]
   (active-feature? (get-from-storage storage feature-name) groups user))

-(defn shoutout [storage groups]
-  {:storage storage
-   :groups groups})
+(defn shoutout
+  "create a shoutout given some storage that implements ShoutoutStorage,
+  and an optional set of group definitions. Group definitions are a map of
+  group names (as strings) to functions that check if a user is in the group
+  "
+  ([storage] (shoutout storage {}))
+  ([storage groups]
+   {:storage storage
+    :groups groups}))


add recur macro

add recur macro

--- src/slag/web.clj
+++ src/slag/web.clj
@@ -25,6 +25,14 @@

 (slag.utils/include "resources")

+(defmacro ss
+	[& form]
+	(let [[root common route args res & nxt] (vec form)]
+		(println ">>>" root common route args res)
+		(println " NXT" nxt)
+		(if-not (nil? nxt)
+			`(ss ~root ~common ~@nxt))))
+
 (defres parsers
   :available-media-types ["text/html"]
   :handle-ok "PARSERSsdf")


Move log statement.

Move log statement.

--- src/onyx/coordinator/distributed.clj
+++ src/onyx/coordinator/distributed.clj
@@ -28,9 +28,8 @@
 (defrecord CoordinatorServer [opts]
   component/Lifecycle
   (start [component]
-    (taoensso.timbre/info "Starting Coordinator Netty server")
-
     (let [coordinator (component/start (onyx-coordinator opts))]
+      (taoensso.timbre/info "Starting Coordinator Netty server")
       (assoc component
         :coordinator coordinator
         :server (jetty/run-jetty (handler coordinator) {:port (:onyx-port opts)


chan_size for es-native.

chan_size for es-native.

--- src/org/spootnik/cyanite/es_path.clj
+++ src/org/spootnik/cyanite/es_path.clj
@@ -177,7 +177,8 @@

 (defn es-native
   [{:keys [index host port cluster_name]
-    :or {index "cyanite" host "localhost" port 9300 cluster_name "elasticsearch"}}]
+    :or {index "cyanite" host "localhost" port 9300 cluster_name "elasticsearch"
+         chan_size 10000}}]
   (let [hosts (map #(vector % port) (if (sequential? host) host [host]))
         conn (esn/connect hosts {"cluster.name" cluster_name})
         existsfn (partial esnd/present? conn index ES_DEF_TYPE)
@@ -192,9 +193,9 @@
       (register [this tenant path]
         (add-path updatefn existsfn tenant path))
       (channel-for [this]
-        (let [es-chan (chan 10000)
-              all-paths (chan 10000)
-              create-path (chan 10000)]
+        (let [es-chan (chan chan_size)
+              all-paths (chan chan_size)
+              create-path (chan chan_size)]
           (go-forever
             (let [p (<! es-chan)]
               (doseq [ap (es-all-paths (get p 0) (get p 1))]


Fix number of arguments

Fix number of arguments

--- src/rdf_path_examples/evaluation.clj
+++ src/rdf_path_examples/evaluation.clj
@@ -51,7 +51,7 @@
         generate-fn (fn [path] (try-times number-of-retries (examples/generate-examples params path)))
         clj->rdf-model (comp json-ld->rdf-model string->input-stream json/generate-string)]
     (doall (mapv (comp average
-                       (fn [[path index]]
+                       (fn [path index]
                          (println (str "Processing path " index "/" path-count))
                          (repeatedly number-of-runs
                                      (comp (partial intra-list-diversity params)


add scroll threshold to carousel

add scroll threshold to carousel

Former-commit-id: 4eaeb4c477fb6fb474011cf5053f59bba6c939ec

--- src/syng_im/components/carousel.cljs
+++ src/syng_im/components/carousel.cljs
@@ -12,7 +12,8 @@

 (def defaults {:gap 10
                :sneak 10
-               :pageWidth (- (page-width) 40)})
+               :pageWidth (- (page-width) 40)
+               :scrollThreshold 20})

 (defn get-gap [data]
@@ -23,6 +24,9 @@

 (defn get-page-width [data]
   (get data :pageWidth (:pageWidth defaults)))
+
+(defn get-scroll-threshold [data]
+  (get data :scrollThreshold (:scrollThreshold defaults)))

 (defn calculate-gap [component props]
   (let [prop-page-width (get-page-width props)
@@ -41,22 +45,29 @@
                                                 :x x})))

 (defn get-current-position [event]
-  (+ (.-x (.-contentOffset (.-nativeEvent event))) (quot (page-width) 2)))
+  (.-x (.-contentOffset (.-nativeEvent event))))

-(defn on-scroll-end [event component]
+(defn on-scroll-end [event component starting-position]
   (let [props (reagent.core/props component)
         state (reagent.core/state component)
         prop-page-width (get-page-width props)
         sneak (get-sneak props)
+        scroll-threshold (get-scroll-threshold props)
         gap (get-gap state)
         page-offset (+ prop-page-width gap)
         current-position (get-current-position event)
-        current-page (quot current-position page-offset)
+        direction (if (> current-position (+ starting-position scroll-threshold))
+                    1
+                    (if (< current-position (- starting-position scroll-threshold))
+                      -1
+                      0))
+        current-page (+ (quot starting-position page-offset) direction)
         ]
     (log/debug "on-scroll-end: prop-page-width=" prop-page-width
                "; sneak=" sneak "; gap=" gap "; page-offset=" page-offset
+               "; starting position=" starting-position
                "; current-position=" current-position
-               "; current-page=" current-page)
+               "; direction=" direction "; current-page=" current-page)
     (scroll-to component (* current-page page-offset) 0)
     (reagent.core/set-state component {:activePage current-page})
     (when (:onPageChange props)
@@ -109,7 +120,8 @@
                        child]])) children)))

 (defn reagent-render [data children]
-  (let [component (reagent.core/current-component)
+  (let [starting-position (atom 0)
+        component (reagent.core/current-component)
         sneak (get-sneak data)
         gap (get-gap data)
         pages (get-pages component data children)]
@@ -121,7 +133,10 @@
                  :bounces false
                  :decelerationRate 0.9
                  :horizontal true
-                 :onScrollEndDrag (fn [event] (on-scroll-end event component))
+                 :onScrollBeginDrag (fn [event]
+                                      (let []
+                                        (reset! starting-position (get-current-position event))))
+                 :onScrollEndDrag (fn [event] (on-scroll-end event component @starting-position))
                  :showsHorizontalScrollIndicator false
                  :ref (fn [c] (set! (.-scrollView component) c))
                  }


Disable a failing test

Disable a failing test

--- test/spec_tools/json_schema_test.clj
+++ test/spec_tools/json_schema_test.clj
@@ -39,7 +39,9 @@
             :additionalProperties false}))
     (is (= (jsc/to-json (s/tuple int? string?))
            {:type "array" :items [{:type "integer"} {:type "string"}] :minItems 2}))
-    (is (= (jsc/to-json (s/every int?)) {:type "array" :items {:type "integer"}}))
+    ;; The next test fails because of
+    ;; <http://dev.clojure.org/jira/browse/CLJ-2035>
+    #_(is (= (jsc/to-json (s/every int?)) {:type "array" :items {:type "integer"}}))
     (is (= (jsc/to-json (s/* int?)) {:type "array" :items {:type "integer"}}))
     (is (= (jsc/to-json (s/+ int?)) {:type "array" :items {:type "integer"} :minItems 1})))
   (testing "composite specs"


remove :results wrapper in test runner state

--- src/bolth.clj
+++ src/bolth.clj
@@ -61,10 +61,9 @@
   (when *test-runner-state*
     (swap! *test-runner-state*
            (fn [runner-state]
-             {:results
-              (conj (:results runner-state)
-                    {:vars v
-                     :runtime runtime})}))))
+             (conj runner-state
+                   {:vars v
+                    :runtime runtime})))))

 (defn test-var [^AbstractQueue result-queue v]
   (when-let [t (:test (meta v))]
@@ -120,7 +119,7 @@

 (defn prioritize-tests [tests]
   (if-let [results @state/*previous-test-run*]
-    (let [mapped-results (group-by (comp str :vars) (:results results))]
+    (let [mapped-results (group-by (comp str :vars) results)]
       (sort-by
         (fn [[test-var _ _ :as test]]
           (get-in mapped-results [(str test-var) 0 :runtime]))
@@ -232,7 +231,6 @@
 (defn format-slow-tests [results options]
   (let [slowest (->> results
                   :test-runner-state
-                  :results
                   (sort-by :runtime)
                   reverse
                   (take (:slow-test-count options 10)))]
@@ -372,8 +370,7 @@

   :test-runner-state
-  {:results
-    [{:vars \"(an-failing-test) (bolth_test.clj:7)\",
+  [{:vars \"(an-failing-test) (bolth_test.clj:7)\",
       :contexts \"\",
       :result
       {:message nil,
@@ -383,7 +380,7 @@
       :type :fail,
       :file \"bolth_test.clj\",
       :line 7},
-      :runtime 37586569}]},
+      :runtime 37586569}],

   iff :show-slow-tests is enabled, will contain a set of test run results.

@@ -400,7 +397,7 @@
      (binding [*out* writer
                *frame-options* (:frame-options options *frame-options*)
                clojure.test/*test-out* writer
-               *test-runner-state* (atom {:results []})]
+               *test-runner-state* (atom [])]
        (clear-screen options)
        (let [f (start-flusher (:flush-interval options 10))
              t0 (System/nanoTime)


Update sample project for changes in neko

The do-ui macro was moved to the neko.threading namespace and renamed to
on-ui.

--- sample/src/clojure/test/leindroid/sample/main.clj
+++ sample/src/clojure/test/leindroid/sample/main.clj
@@ -1,7 +1,8 @@
 (ns test.leindroid.sample.main
-  (:use [neko.activity :only [defactivity do-ui set-content-view!]]
+  (:use [neko.activity :only [defactivity set-content-view!]]
         [neko.notify :only [toast]]
-        [neko.ui :only [defui by-id]]
+        [neko.ui :only [defui]]
+        [neko.threading :only [on-ui]]
         [neko.application :only [defapplication]]))

 (declare ^android.app.Activity a
@@ -19,7 +20,7 @@
   :def a
   :create
   (fn [this bundle]
-    (do-ui
+    (on-ui
      (set-content-view! a
       (defui [:linear-layout {:orientation :vertical
                               :layout-width :fill


load figwheel-config only when needed

load figwheel-config only when needed

--- dev/clj/user.clj
+++ dev/clj/user.clj
@@ -3,17 +3,18 @@
             [com.stuartsierra.component :as component]))

 ;;FIGWHEEL
-(def figwheel-config (fig/fetch-config))
 (def figwheel (atom nil))

 (defn start-figwheel
   "Start Figwheel on the given builds, or defaults to build-ids in `figwheel-config`."
   ([]
-   (let [props (System/getProperties)
+   (let [figwheel-config (fig/fetch-config)
+         props (System/getProperties)
          all-builds (->> figwheel-config :data :all-builds (mapv :id))]
      (start-figwheel (keys (select-keys props all-builds)))))
   ([build-ids]
-   (let [default-build-ids (-> figwheel-config :data :build-ids)
+   (let [figwheel-config (fig/fetch-config)
+         default-build-ids (-> figwheel-config :data :build-ids)
          build-ids (if (empty? build-ids) default-build-ids build-ids)
          preferred-config (assoc-in figwheel-config [:data :build-ids] build-ids)]
      (reset! figwheel (component/system-map


Remove ros from user.clj

Remove ros from user.clj

--- src/user.clj
+++ src/user.clj
@@ -10,6 +10,7 @@
 (defn uall [] (u util envs search search.algorithms.textbook angelic angelic.hierarchies domains.nav-switch domains.strips  angelic.dnf-valuations angelic.ncstrips-descriptions angelic.hierarchies.strips-hierarchies util.queues util.graphs domains.warehouse  domains.discrete-road-trip domains.road-trip angelic.hierarchies.abstract-lookahead-trees angelic.hierarchies.abstract-lookahead-graphs #_ angelic.hierarchies.clause-graphs angelic.hierarchies.offline-algorithms angelic.hierarchies.online-algorithms scripts.experiments scripts.cluster #_ scripts.z09-aij scripts.z09-icaps08-tr util.datasets util.charts util.graphviz scripts.timing-warehouse scripts.timing-nav-switch ))
 ; domains.hybrid-strips domains.hybrid-blocks

+(comment
 (defn lr [] (require '[ros ros nav] :reload-all))

 (defmacro ur [& args]
@@ -18,7 +19,7 @@
 	       )
        (use ~@(map #(list 'quote (if (coll? %) (cons (symbol-append 'ros. (first %)) (rest %)) (symbol-append 'ros. %))) args))))

-(defn uros [] (ur ros nav))
+(defn uros [] (ur ros nav)))

 ; These may be useful but cause gui to load
 (use 'clojure.inspector)


y velocity needs to be negative because of coordinate system

--- src-cljs/hello.cljs
+++ src-cljs/hello.cljs
@@ -18,7 +18,7 @@

 (defn random-angle-vector []
   {:x (- .5 (rand))
-   :y (+ .5 (rand))})
+   :y (- -0.5 (rand))})

 (defn spawn-random-rocket [game-world]
   (let [rockets (aget game-world :rockets)


warn users when tieredStopAtLevel is set to 1

--- src/overtone/api.clj
+++ src/overtone/api.clj
@@ -1,4 +1,5 @@
 (ns overtone.api
+  (:import [java.lang.management ManagementFactory])
   (:use [overtone.libs boot-msg app-icon]
         [overtone.helpers.ns])
   (:require clojure.stacktrace
@@ -6,16 +7,46 @@
             [overtone version osc speech]
             [overtone.algo chance scaling trig fn]
             [overtone.sc bindings buffer bus envelope example info
-                         ugens defcgen node sample server synth
-                         foundation-groups dyn-vars trig]
+             ugens defcgen node sample server synth
+             foundation-groups dyn-vars trig]
             [overtone.sc.cgens oscillators demand mix io buf-io env tap
-                               line freq beq-suite berlach bhob info]
+             line freq beq-suite berlach bhob info]
             [overtone.music rhythm pitch tuning time]
             [overtone.studio mixer inst util fx wavetable midi midi-player core]
             [overtone.repl ugens examples shell inst debug graphviz]
             [overtone.libs asset event]
             [overtone.gui scope mixer control]
-            [overtone.samples freesound]))
+            [overtone.samples freesound]
+            [overtone.helpers.doc :refer [fs]]))
+
+
+;; Currently the default lein setting drastically reduces performance in
+;; return for a 200ms improvement of the startup time. See:
+;; https://github.com/technomancy/leiningen/pull/1230
+(defonce __PRINT_TIERED_COMPILATION_WARNING__
+  (let [compiler-bean (ManagementFactory/getCompilationMXBean)
+        compiler-name (.getName compiler-bean)
+        runtime-bean (ManagementFactory/getRuntimeMXBean)
+        input-args    (.getInputArguments runtime-bean)]
+
+    (when-let [arg (and (re-find #"Tiered" compiler-name)
+                        (some #(re-find #"TieredStopAtLevel=1" %)
+                              input-args))]
+      (println
+       (fs "**********************************************************
+            WARNING: JVM argument TieredStopAtLevel=1 is active, and may
+            lead to reduced performance. This happens to currently be
+            the default lein setting:
+
+            https://github.com/technomancy/leiningen/pull/1230
+
+            If you didn't intend this JVM arg to be specified, you can
+            turn it off in your project.clj file or your global
+            ~/.lein/profiles.clj file by adding the key-val
+
+            :jvm-opts ^:replace []
+              **********************************************************")))))
+

 (defn immigrate-overtone-api []
   (immigrate


Update main.cljs

Update main.cljs

Christina - I've removed the "view an illustrative example" text since we don't have this as separate any more. I will add something to map & data header to say that this is available on individual hospital views.

--- src/prais2/main.cljs
+++ src/prais2/main.cljs
@@ -70,7 +70,7 @@
    [:.row
     [:.col-sm-12
      [:h1 "Explore the data"]
-     [:h4 {:clear "both"} "View an illustrative example or the data presented in a map or a list"]
+     [:h4 {:clear "both"} "View the data presented in a map or a list"]
      [:ul.nav.nav-pills {:role "tablist"
                          :style {:clear "both"}}


:rente-port -> :port for Heroku compliancy

--- src/rente/config.clj
+++ src/rente/config.clj
@@ -2,4 +2,4 @@
   (:require [environ.core :refer [env]]))

 (defn get-config []
-  {:port (Integer/parseInt (or (env :rente-port) "8080"))})
+  {:port (Integer/parseInt (or (env :port) "8080"))})


diffrevpairs -> diff-revpairs

diffrevpairs -> diff-revpairs

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -1,4 +1,4 @@
-;; TODO make diffrevpairs non-recursive?
+;; TODO make diff-revpairs non-recursive?

 (ns revdiff.core
   (:gen-class)
@@ -49,14 +49,14 @@
 ;; (if any) is present on a changed line in that pair. If no filter term is
 ;; given, diff all changed files from all revision pairs.

-(defn diffrevpairs [object filt revpairs show insens]
+(defn diff-revpairs [object filt revpairs show insens]
   (when (seq revpairs)
     (let [r1 (first revpairs)
           r2 (first (rest revpairs))
           mf (matching-files r1 r2 object filt show insens)]
       (println (str "Checking: r" r1 " vs r" r2))
       (doseq [filename mf] (svndiff r1 r2 filename object show))
-      (diffrevpairs object filt (rest (rest revpairs)) show insens))))
+      (diff-revpairs object filt (rest (rest revpairs)) show insens))))

 ;; Try to explain why this has failed.

@@ -171,5 +171,5 @@
       (usage summary 1)
       (let [revlist (get-revlist optsl show object)
             revpairs (get-revpairs revlist object)]
-        (diffrevpairs object filt revpairs show insens)
+        (diff-revpairs object filt revpairs show insens)
         (shutdown-agents)))))


CMR-397: Added tests for granule two d coordinate system search parameter validation.

--- test/cmr/system_int_test/search/granule_grid_search_test.clj
+++ test/cmr/system_int_test/search/granule_grid_search_test.clj
@@ -120,6 +120,17 @@
            ;; search by multiple grids
            [gran3 gran11] ["one CALIPSO:160-170,350-360" "BRAVO:100,310"]))

+    (testing "invalid grid parameters"
+      (are [two-d error]
+           (let [{:keys [status errors]} (search/find-refs :granule {:grid two-d})]
+             (is (= [400 [error]]
+                    [status errors])))
+           " :1," "grid name can not be empty, but is for [ :1,]"
+           "name:x" "grid values [x] must be numeric value or range"
+           "name:10-x" "grid values [10-x] must be numeric value or range"
+           "name:10-5" "Invalid grid range for [10-5]"
+           "name:6,10-5" "Invalid grid range for [10-5]"))
+
     (testing "catalog-rest style"
       (are [items two-d-name coords]
            (let [search-params {"two_d_coordinate_system[name]" two-d-name}
@@ -127,8 +138,7 @@
                                  (merge search-params
                                         {"two_d_coordinate_system[coordinates]" coords})
                                  search-params)]
-             (d/refs-match? items (search/find-refs
-                                    :granule search-params)))
+             (d/refs-match? items (search/find-refs :granule search-params)))
            ;; search by grid name
            [gran11] "BRAVO" nil
            ;; search by grid value
@@ -143,6 +153,22 @@
            [gran3 gran4] "one CALIPSO" "160-170:350-360,150-160:330-340"
            [gran3 gran4 gran5 gran6 gran9 gran10]
            "one CALIPSO" "160-170:350-360,150-160:330-340,-:360-"))
+
+    (testing "invalid catalog-rest two-d-coordinate-system parameters"
+      (are [two-d-name coords error]
+           (let [search-params {"two_d_coordinate_system[name]" two-d-name}
+                 search-params (if coords
+                                 (merge search-params
+                                        {"two_d_coordinate_system[coordinates]" coords})
+                                 search-params)
+                 {:keys [status errors]} (search/find-refs :granule search-params)]
+             (is (= [400 [error]]
+                    [status errors])))
+           " " "1" "grid name can not be empty, but is for [ :1]"
+           "name" "x" "grid values [x] must be numeric value or range"
+           "name" "10-x" "grid values [10-x] must be numeric value or range"
+           "name" "10-5" "Invalid grid range for [10-5]"
+           "name" "6,10-5" "Invalid grid range for [10-5]"))

     (testing "search by two d coordinate system with aql"
       (are [items two-d]


minor

minor


substitute instead of content

substitute instead of content

--- src/shelver/html.clj
+++ src/shelver/html.clj
@@ -40,7 +40,7 @@

 (html/deftemplate base "templates/base.html" [{:keys [uri] :as req} {:keys [title] :as props}]
                   [:head :title] (html/content title)
-                  [:body :div.navbar] (html/content (nav uri)))
+                  [:body :div.navbar] (html/substitute (nav uri)))

 (defn index [request]
   (base request {:title "shelver"}))


Move loader state under sparated atom under uxbox.state ns.

--- src/uxbox/state.cljs
+++ src/uxbox/state.cljs
@@ -17,9 +17,7 @@
   (-> (l/key :auth)
       (l/focus-atom state)))

-(def loader-l
-  (-> (l/key :loader)
-      (l/focus-atom state)))
+(def loader (atom false))

 (defn get-initial-state
   []


Support for passing the 'm' map to build via the rendering functions; mainly so I can use :opts for the text-editor widget

--- web-client/test/test_burgerboard/huh.cljs
+++ web-client/test/test_burgerboard/huh.cljs
@@ -39,10 +39,13 @@
    (gensym) nil)
   )

-(defn rendered-component [component state]
-  (binding [om/*state* state]
-    (.render (om/build* component (om/to-cursor @state state [])))
-    )
+(defn rendered-component
+  ([component state] (rendered-component component state nil))
+  ([component state m]
+     (binding [om/*state* state]
+       (.render (om/build* component (om/to-cursor @state state []) m))
+       )
+     )
   )

 (defn get-child [component child]
@@ -58,10 +61,18 @@
   (reduce get-child component accessors)
   )

+(defn -extract-m [tests]
+  (if (map? (first tests))
+    [(first tests) (rest tests)]
+    [nil tests]
+    )
+  )
+
 (defn rendered [component value & tests]
-  (let [state (setup-state value)]
+  (let [[m tests] (-extract-m tests)
+        state (setup-state value)]
     (binding [om/*instrument* -instrument]
-      (let [rendered-comp (rendered-component component state)]
+      (let [rendered-comp (rendered-component component state m)]
         (test-predicates tests rendered-comp {:in "rendered component"})
         )
       )


Move JSON response constructor to util.

Move JSON response constructor to util.

--- src/kosha/app/util.clj
+++ src/kosha/app/util.clj
@@ -1,5 +1,6 @@
 (ns kosha.app.util
-  (:require [clojure.string :as s])
+  (:require [clojure.string :as s]
+            [cheshire.core :as json])
   (:import [java.util.concurrent
             ThreadPoolExecutor
             TimeUnit
@@ -39,3 +40,8 @@
                    (.invokeAll pool tasks))]
     (.shutdown pool)
     rets))
+
+(defn json-response [response]
+  {:status 200
+   :body (json/encode response)
+   :content-type "application/json"})


fix NPE when doing "lein core"

fix NPE when doing "lein core"

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -51,12 +51,14 @@

 (defn resolve-task [task]
   (let [task-ns (symbol (str "leiningen." task))
-        task (symbol task)]
+        task (symbol task)
+        not-found-fn (partial task-not-found task)]
     (try
      (require task-ns)
-     (ns-resolve task-ns task)
+     (or (ns-resolve task-ns task)
+         not-found-fn)
      (catch java.io.FileNotFoundException e
-       (partial task-not-found task)))))
+       not-found-fn))))

 (defn -main [& [task & args]]
   (let [task (or (aliases task) task "help")


Use read-line instead of read in repl-client.

--- src/leiningen/repl.clj
+++ src/leiningen/repl.clj
@@ -59,14 +59,10 @@
       (recur))))

 (defn repl-client [reader writer]
-  (let [eof (Object.)
-        input (try (read *in* false eof)
-                   (catch Exception e
-                     (println "Couldn't read input.")))]
-    (when-not (= eof input)
-      (.write writer (str (pr-str input) "\n"))
-      (.flush writer)
-      (recur reader writer))))
+  (when-let [input (read-line)]
+    (.write writer (str input "\n"))
+    (.flush writer)
+    (recur reader writer)))

 (defn- connect-to-server [socket]
   (let [reader (InputStreamReader. (.getInputStream socket))


Update pldb incrementally instead of all at once

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1054,22 +1054,117 @@
 (pldb/db-rel r-tree ^:index sha ^:index name type ^:index obj-sha)
 (pldb/db-rel r-proj ^:index blob-sha ^:index proj-name vmajor vminor vinc vqual has-snaps?)

-(defn git-logic-tuples
-  [gitdir]
-  (let [commits (git-commits gitdir "origin/master")]
-    (concat
-     ;; Graph of commits
-     (mapcat seq
-             (for [{:keys [sha ctime tree parents]} commits
-                   :let [bsha (sha/mk sha)]]
-               (into [[r-commit bsha (Long/parseLong ctime) (sha/mk tree)]]
-                     (for [p parents]
-                       [r-commit-parent bsha (sha/mk p)]))))
-     ;; Trees (you know, files and directories)
-     (for [tree-sha (all-git-trees gitdir)
-           :let [tree-bsha (sha/mk tree-sha)]
-           [fname {:keys [sha ftype]}] (git-tree gitdir tree-sha)]
-       [r-tree tree-bsha fname (keyword ftype) (sha/mk sha)]))))
+(defn sem-ver-parse [ver-str]
+  (let [vparts (re-matches #"(?:(\d+)\.)?(?:(\d+)\.)?(?:(\d+)-)?(.*)" ver-str)
+        [vqual & vnums] (reverse (filter identity (next vparts)))
+        [vmajor vminor vinc] (map #(if (and (string? %) (re-matches #"[0-9]*" %))
+                                     (Integer/parseInt %)
+                                     %) (reverse vnums))]
+    [vmajor vminor vinc vqual]))
+
+(defn reduce-db
+  [db coll f]
+  (if (empty? coll)
+    db
+    (reduce f (vary-meta db assoc ::dirty true) coll)))
+
+(defn add-r-commits
+  [db gitdir]
+  (let [old-branches (pldb/with-db db
+                       (l/run* [q]
+                               (l/fresh [name sha]
+                                        (r-branch name sha)
+                                        (l/== q [name sha]))))
+        db-without-branches (reduce
+                             (fn [db [name sha]]
+                               (pldb/db-retraction db r-branch name sha))
+                             db old-branches)
+        new-branches (map list
+                          (origin-branches gitdir)
+                          (origin-branches gitdir :sha? true))
+        log-args (concat (map second new-branches)
+                         (map #(str "^" %) (map second old-branches)))
+        db (reduce
+            (fn [db [name sha]]
+              (pldb/db-fact db r-branch name (sha/mk sha)))
+            db new-branches)]
+    ;; TODO -- dirty db on branch change
+    (reduce-db
+     db (apply git-commits gitdir log-args)
+     (fn [db {:keys [sha ctime tree parents]}]
+       (let [bsha (sha/mk sha)
+             db (pldb/db-fact db r-commit
+                              bsha
+                              (Date. (* 1000 (Long/parseLong ctime)))
+                              (sha/mk tree))]
+         (reduce (fn [db parent]
+                   (pldb/db-fact db r-commit-parent bsha (sha/mk parent)))
+                 db parents))))))
+
+(defn add-r-trees
+  [db gitdir]
+  (let [[trees read-trees]
+        (pldb/with-db db
+          [(l/run* [tree-sha] (l/fresh [sha ct] (r-commit sha ct tree-sha)))
+           (l/run* [tree-sha]
+                   (l/fresh [fname ftype obj-sha]
+                            (r-tree tree-sha fname ftype obj-sha)))])
+        tree-shas (apply disj (set trees) read-trees)]
+    (if (empty? tree-shas)
+      db ;; nothing to do
+      (loop [db (vary-meta db assoc ::dirty true)
+             tree-shas tree-shas]
+        (if (empty? tree-shas)
+          db ;; done
+          (let [tree (first tree-shas)
+                more-trees (disj tree-shas tree)]
+            (if (seq (l/run 1 [n] (l/fresh [t s] (r-tree tree n t s))))
+              (recur db more-trees) ;; this tree is done already
+              (let [sub-trees (git-tree gitdir (str tree))
+                    db (reduce
+                        (fn [db [fname {:keys [sha ftype]}]]
+                          (pldb/db-fact db r-tree tree fname
+                                        (keyword ftype) (sha/mk sha)))
+                        db
+                        sub-trees)
+                    more-trees (into more-trees
+                                     (keep (fn [[_ {:keys [ftype sha]}]]
+                                             (when (= "tree" ftype)
+                                               (sha/mk sha)))
+                                          sub-trees))]
+                (recur db more-trees)))))))))
+
+(defn add-r-projs
+  [db gitdir]
+  (let [[proj-blobs read-blobs]
+        (pldb/with-db db
+          [(l/run* [blob-sha]
+                   (l/fresh [proj-dir-sha]
+                            (r-tree proj-dir-sha "project.clj" :blob blob-sha)))
+           (l/run* [blob-sha]
+                   (l/fresh [proj-name vmajor vminor vinc vqual has-snaps?]
+                            (r-proj blob-sha proj-name
+                                    vmajor vminor vinc vqual has-snaps?)))])]
+    (reduce-db
+     db (apply disj (set proj-blobs) read-blobs)
+     (fn [db blob-sha]
+       (if-let [proj (robust-read-proj-blob gitdir blob-sha)]
+         (let [proj-name (symbol (:group proj) (:name proj))
+               has-snaps? (some #(.contains ^String % "-SNAPSHOT")
+                                (map second (:dependencies proj)))
+               [vmajor vminor vinc vqual] (sem-ver-parse (:version proj))]
+           (pldb/db-fact db r-proj blob-sha proj-name
+                         vmajor vminor vinc vqual has-snaps?))
+         db)))))
+
+(defn update-git-db
+  [db gitdir]
+  (let [db (-> db
+               (add-r-commits gitdir)
+               (add-r-trees gitdir)
+               (add-r-projs gitdir))]
+    ;; TODO: if dirty, write out db
+    db))

 (defn file-patho
   [tree-sha so-far fname fsha tree-path]
@@ -1087,38 +1182,6 @@
            [(l/fresh [nparent]
                      (r-commit-parent childer nparent)
                      (ancestoro nparent parenter))])))
-
-(defn sem-ver-parse [ver-str]
-  (let [vparts (re-matches #"(?:(\d+)\.)?(?:(\d+)\.)?(?:(\d+)-)?(.*)" ver-str)
-        [vqual & vnums] (reverse (filter identity (next vparts)))
-        [vmajor vminor vinc] (map #(if (and (string? %) (re-matches #"[0-9]*" %))
-                                     (Integer/parseInt %)
-                                     %) (reverse vnums))]
-    [vmajor vminor vinc vqual]))
-
-(defn add-r-projs
-  [gitdir db]
-  (pldb/with-db db
-    (let [proj-blobs (l/run* [blob-sha]
-                       (l/fresh [proj-dir-sha]
-                         (r-tree proj-dir-sha "project.clj" :blob blob-sha)))
-          read-blobs (l/run* [blob-sha]
-                       (l/fresh [proj-name vmajor vminor vinc vqual has-snaps?]
-                         (r-proj blob-sha proj-name
-                                 vmajor vminor vinc vqual has-snaps?)))
-          blobs-to-read (apply disj (set proj-blobs) read-blobs)]
-      (reduce
-       (fn [db blob-sha]
-         (if-let [proj (robust-read-proj-blob gitdir blob-sha)]
-           (let [proj-name (symbol (:group proj) (:name proj))
-                 has-snaps? (some #(.contains ^String % "-SNAPSHOT")
-                                  (map second (:dependencies proj)))
-                 [vmajor vminor vinc vqual] (sem-ver-parse (:version proj))]
-             (pldb/db-fact db r-proj blob-sha proj-name
-                           vmajor vminor vinc vqual has-snaps?))
-           db))
-       db
-       blobs-to-read))))

 (comment
   (l/run* [q] (l/fresh [q] (l/== (sha/mk "7b3e68a8839aeb4")
@@ -1130,8 +1193,8 @@
   (def xdb3 (vdb/from-reldata [r-tree] (fress/read (fress/write (vdb/to-reldata xdb1)))))
   (pldb/with-db xdb3 (l/run* [a] (r-tree a :b :c :d)))

-  (time (def db (apply pldb/db (git-logic-tuples (io/file voom-repos "lein-voom")))))
-  (time (def db2 (add-r-projs (io/file voom-repos "lein-voom") db)))
+  (time (def db (update-git-db pldb/empty-db (io/file voom-repos "lein-voom"))))
+  (time (def db2 (update-git-db db (io/file voom-repos "lein-voom"))))
   (time (fress-spit-seq "tmp.frs" (vdb/to-reldata db2)))
   (time (def db3
           (vdb/from-reldata [r-branch r-commit r-commit-parent r-tree r-proj]


'robust-read-project is now more thread-safe

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -260,19 +260,22 @@
       (apply f filename args)
       default-val)))

+;; Shhh...
+(.setDynamic #'slurp)
+(.setDynamic #'load-file)
 (defn robust-read-project
   [gitdir sha prj-path]
   (try
     ;; Hack to work around our crazy project.clj files
-    (with-redefs [slurp (patch-fn slurp "{}")
-                  load-file (patch-fn load-file {})]
+    (binding [slurp (patch-fn slurp "{}")
+              load-file (patch-fn load-file {})]
       (read-project gitdir sha prj-path))
     (catch Exception e
       ;; 128 means git complained about
       ;; something. Probably a non-existant
       ;; project.clj at this sha.
       (when-not (= 128 (:exit (ex-data e)))
-        (println "Skipping error:" (pr-str e)))
+        (println "Ignoring error:" (pr-str e)))
       nil)))

 (defn re-quote [s]


fixes for the most comments view

fixes for the most comments view

--- src/ontrail/unread.clj
+++ src/ontrail/unread.clj
@@ -32,8 +32,8 @@
   (ex/decorate-results user (filter (partial is-own? user) (get-unread-objs user))))

 (defn most-comments-oids []
-  (let [two-weeks-ago (time/minus (time/now) (time/days 30))]
-    (mc/aggregate "exercise" [{"$match" {:lastModifiedDate {"$gte" two-weeks-ago}}} {"$unwind" "$comments"} {"$group" {"_id" "$_id" "size" {"$sum" 1}}} {"$sort" {"size" -1}} {"$limit" 50}])))
+  (let [four-weeks-ago (time/minus (time/now) (time/days 30))]
+    (mc/aggregate "exercise" [{"$match" {:lastModifiedDate {"$gte" four-weeks-ago}}} {"$unwind" "$comments"} {"$group" {"_id" "$_id" "size" {"$sum" 1}}} {"$sort" {"size" -1}} {"$limit" 50}])))

 (defn most-comments [user]
   (ex/decorate-results user (map (comp find-exercise :_id) (most-comments-oids))))


notifos issue

notifos issue

--- src/lt/plugins/go.cljs
+++ src/lt/plugins/go.cljs
@@ -15,7 +15,7 @@
             [lt.objs.tabs :as tabs])
   (:require-macros [lt.macros :refer [behavior]]))

-;; Declares a new object called "go-lang" and also lets you asign things to it;
+;; Declares a new object called "go-lang" and also lets you assign things to it;
 ;; in your case a set of with just a tag.
 (object/object* ::go-lang
                 :tags #{:go.lang}
@@ -162,7 +162,7 @@
 (defn gofmt [file]
   "Performs `gofmt -w file`."
   (let [cmd (str "gofmt -w " file)]
-    (notifos/working (str "gofmt " file))
+    (notifos/working (str "gofmt " file "..."))
     (run-cmd cmd)
     (notifos/done-working "")))


Fix scaling

Fix scaling

--- src/play_clj/utils.clj
+++ src/play_clj/utils.clj
@@ -84,9 +84,18 @@
   `~(static-symbol args key->upper))

 (defmacro scaling
-  "Internal use only"
+  "Returns a static field from [Scaling](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/utils/Scaling.html)
+
+    (scaling :fill)
+    (scaling :fill-x)
+    (scaling :fill-y)
+    (scaling :fit)
+    (scaling :none)
+    (scaling :stretch)
+    (scaling :stretch-x)
+    (scaling :stretch-y)"
   [k]
-  `(static-field-lower :utils :Scaling ~k))
+  `(static-field-lower main-package :utils :Scaling ~k))

 ; java interop


Drop drop-keys in favour of dissoc.

Drop drop-keys in favour of dissoc.

--- src/postal/message.clj
+++ src/postal/message.clj
@@ -179,7 +179,7 @@
          (.setSubject (:subject msg))
          (.setSentDate (or (:date msg) (make-date)))
          (.addHeader "User-Agent" (:user-agent msg (user-agent)))
-         (add-extra! (drop-keys msg standard))
+         (add-extra! (apply dissoc msg standard))
          (add-body! (:body msg) charset)
          (.saveChanges)))))


mobile menu closes on click

mobile menu closes on click

--- src/prais2/chrome.cljc
+++ src/prais2/chrome.cljc
@@ -38,7 +38,9 @@
 (rum/defc bs-nav-link [active? nav-item click-handler]
   [:li
    [:a.navbar-btn {:on-click click-handler
-                   :class (str (if active? " active " " ") (:class nav-item))}
+                   :class (str (if active? " active " " ") (:class nav-item))
+                   :data-toggle "collapse"
+                   :data-target ".navbar-collapse"}
     [:i.fa {:class (str "fa-" (:icon nav-item))}]
     (str " " (:short-title nav-item))]])


Simplify using threading macros

Simplify using threading macros

--- src/mdr2/pipeline1.clj
+++ src/mdr2/pipeline1.clj
@@ -2,22 +2,30 @@
   (:use [clojure.java.shell :only [sh]])
   (:require [clojure.string :as s]))

+(defn- clean-line [line file]
+  (-> line
+      (s/replace "[ERROR, Validator]" "")
+      (s/replace (str "Location: file:" file) "Line:")
+      (s/trim)))
+
+(defn- filter-output [output file]
+  (->> output
+       (s/split-lines)
+       (filter #(re-matches #"^\[ERROR, Validator\].*" %))
+       (map #(clean-line % file))))
+
 (defn validate [file]
-  (sh "daisy-pipeline"
-      "/usr/lib/daisy-pipeline/scripts/verify/ConfigurableValidator.taskScript"
-      (str "--validatorInputFile=" file)
-      ;; make sure it has to be a DTBook file
-      "--validatorRequireInputType=Dtbook document"
-      ;; make sure files with a missing DOCTYPE declaration do not validate
-      "--validatorInputDelegates=org.daisy.util.fileset.validation.delegate.impl.NoDocTypeDeclarationDelegate"))
+  (-> (sh "daisy-pipeline"
+          "/usr/lib/daisy-pipeline/scripts/verify/ConfigurableValidator.taskScript"
+          (str "--validatorInputFile=" file)
+          ;; make sure it has to be a DTBook file
+          "--validatorRequireInputType=Dtbook document"
+          ;; make sure files with a missing DOCTYPE declaration do not validate
+          "--validatorInputDelegates=org.daisy.util.fileset.validation.delegate.impl.NoDocTypeDeclarationDelegate")
+      (:out)
+      (filter-output file)))

 (defn audio-encoder [args]
   (apply sh "daisy-pipeline"
          "/usr/lib/daisy-pipeline/scripts/modify_improve/dtb/DTBAudioEncoder.taskScript"
          (map (fn [[k v]] (format "--%s=%s" (name k) v)) args)))
-
-(defn filter-output [lines]
-  (map #(s/trim (s/replace % "[ERROR, Validator]" ""))
-       (filter #(re-matches #"^\[ERROR, Validator\].*" %)
-               (s/split-lines lines))))
-


[l.d.build] Pass proguard-out-jar as a vector to run-dx

See #129.

--- src/leiningen/droid/build.clj
+++ src/leiningen/droid/build.clj
@@ -125,7 +125,7 @@
   (if proguard-execute
     (do
       (run-proguard-minifying project)
-      (run-dx project proguard-output-jar-path))
+      (run-dx project [proguard-output-jar-path]))
     (let [deps (resolve-dependencies :dependencies project)
           external-classes-paths (or external-classes-paths [])]
       (run-dx project (concat [compile-path] deps external-classes-paths)))))


[ci skip] Fix test.

[ci skip] Fix test.

--- test/onyx/log/one_job_test.clj
+++ test/onyx/log/one_job_test.clj
@@ -7,9 +7,9 @@
             [onyx.api :as api]
             [midje.sweet :refer :all]))

+(def config (load-config))
+
 (def onyx-id (java.util.UUID/randomUUID))
-
-(def config (load-config))

 (def env-config (assoc (:env-config config) :onyx/id onyx-id))

@@ -62,13 +62,13 @@
   {:lifecycle/before-task :onyx.peer.one-job-test/inject-out-ch})

 (def lifecycles
-  [{:lifecycle/task :in
+  [{:lifecycle/task :a
     :lifecycle/calls :onyx.peer.one-job-test/in-calls}
-   {:lifecycle/task :in
+   {:lifecycle/task :a
     :lifecycle/calls :onyx.plugin.core-async/reader-calls}
-   {:lifecycle/task :out
+   {:lifecycle/task :c
     :lifecycle/calls :onyx.peer.one-job-test/out-calls}
-   {:lifecycle/task :out
+   {:lifecycle/task :c
     :lifecycle/calls :onyx.plugin.core-async/writer-calls}])

 (defn my-inc [segment]


Optionally timeout resuming a webdriver.

Refs #21.

--- src/shale/sessions.clj
+++ src/shale/sessions.clj
@@ -276,14 +276,30 @@
               candidate))
           (create-session requirements))))))

-(defn resume-webdriver-from-id [session-id]
+(defn resume-webdriver-from-id
+  "Resume and return a web driver from a session id. Optionally include a
+  timeout, in milliseconds.
+
+  Throws an exception on timeout, but blocks forever by default."
+  [session-id & {:keys [timeout]}]
   (if-let [model (view-model session-id)]
-    (apply resume-webdriver
-
-           (map-indexed (fn [index e] (if (= index 2) {"browserName" e} e))
+    (let [resume-args (map-indexed
+                        (fn [index e] (if (= index 2) {"browserName" e} e))
                         [(model :id)
                          (get-in model [:node :url])
-                         :browser-name]))))
+                         :browser-name])
+          future-wd (future (apply resume-webdriver resume-args))
+          wd (if (nil? timeout)
+               (deref future-wd)
+               (deref future-wd timeout ::timeout))]
+      (if (= wd ::timeout)
+        (do
+          (future-cancel future-wd)
+          (throw (ex-info "Timeout resuming session."
+                          {:session-id session-id :timeout timeout})))
+        wd))
+    (throw (ex-info "Unknown session id."
+                    {:session-id session-id}))))

 (defn destroy-session [session-id]
   (with-car*


Turn off optimized rendering for now

Turn off optimized rendering for now

--- src/snergly/image.cljs
+++ src/snergly/image.cljs
@@ -8,7 +8,7 @@
 ;;
 ;; Any variable called 'g' is a CanvasRenderingContext2D object.

-(def optimize-drawing true)
+(def optimize-drawing false)

 ;; To debug the optimized drawing:
 ;; * set snergly.image/optimize-drawing to true