Add doc for "background changers" + 2 new guides

--- src/midje/doc.clj
+++ src/midje/doc.clj
@@ -24,6 +24,7 @@
                  midje-arrows
                  midje-setup
                  midje-teardown
+                 midje-background-changers

                  midje-configuration
                  midje-print-level
@@ -323,9 +324,47 @@
 "} midje-configuration)

+(def ^{:doc "
+   There are two types of background-changers. The first provides a default
+   prerequisite and has the same format as `provided`. Here's an example of
+   two inside in a `background` form:
+
+      (background (f 33) => 12, (f 34) => 21)
+
+   The other form runs arbitrary code before, after, or around a fact or
+   individual check. Here's how you execute some setup code before each of a
+   series of facts:
+
+      (against-background [(before :facts (reset! some-atom 0))]
+         (fact ...)
+         (fact ...))
+
+   Here's how you execute some code after each check in a fact:
+
+      (against-background [(after :checks (reset! some-atom 0))]
+        (fact
+          (f 1) => 2   ; Reset happens after.
+          (f 2) => 3)) ; Reset happens after.
+
+   You can execute code both before and after a fact like this:
+
+      (against-background [(before :facts (reset! in-atom 0)
+                                   :after (reset! out-atom 0))]
+         (fact ...)
+         (fact ...))
+
+   You can also wrap code around a fact or check:
+
+      (against-background [(around :facts (sql/with-connection db ?form))]
+         ...)
+
+   The two types of background-changers can be intermingled.
+"} midje-background-changers)

 (def guide-topics {
+ 'background-prerequisites "https://github.com/marick/Midje/wiki/Background-prerequisites"
+ 'setup-and-teardown "https://github.com/marick/Midje/wiki/Setup%2C-Teardown%2C-and-State"
  'future-facts  "https://github.com/marick/Midje/wiki/Future-facts"
  'checkers-within-prerequisites "https://github.com/marick/Midje/wiki/Checkers-within-prerequisites"
  'chatty-checkers "https://github.com/marick/Midje/wiki/Chatty-checkers"


First set test.

First set test.

--- src/cbfg/store-test.cljs
+++ src/cbfg/store-test.cljs
@@ -4,11 +4,15 @@
             [cbfg.store :as store]))

 (defn e [n result expect]
-  (println (str (swap! n inc) ":")
-           (if (= result expect)
-             (str "pass: " (:key expect))
-             (str "FAIL:" result expect)))
-  (= result expect))
+  (let [result2 (if (:cas expect)
+                  result
+                  (dissoc result :cas))
+        pass (= result2 expect)]
+    (println (str (swap! n inc) ":")
+             (if pass
+               (str "pass: " (:key expect))
+               (str "FAIL:" result2 expect)))
+    pass))

 (defn test [actx opaque-id]
   (ago test actx
@@ -25,6 +29,8 @@
                   (e n (atake test (store/store-set test s 5 "does-not-exist" 0 "" :append))
                      {:status :not-found, :key "does-not-exist", :opaque 5})
                   (e n (atake test (store/store-set test s 6 "does-not-exist" 0 "" :replace))
-                     {:status :not-found, :key "does-not-exist", :opaque 6}))
+                     {:status :not-found, :key "does-not-exist", :opaque 6})
+                  (e n (atake test (store/store-set test s 7 "does-not-exist" 0 "7" :set))
+                     {:status :ok, :key "does-not-exist", :opaque 7, :sq 2}))
            "pass"
            (str "FAIL: on test #" @n)))))


validating with envs

validating with envs

--- src/celestial/config.clj
+++ src/celestial/config.clj
@@ -1,13 +1,13 @@
 (comment
-   Celestial, Copyright 2012 Ronen Narkis, narkisr.com
-   Licensed under the Apache License,
-   Version 2.0  (the "License") you may not use this file except in compliance with the License.
-   You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS,
-   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-   See the License for the specific language governing permissions and
-   limitations under the License.)
+  Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+  Licensed under the Apache License,
+  Version 2.0  (the "License") you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.)

 (ns celestial.config
   "Celetial configuration info"
@@ -27,50 +27,51 @@
   {:redis {:host #{:required :String}} :ssh {:private-key-path #{:required :String}}})

 (validation :levels
-  (when-not-nil levels (<< "level must be either ~{levels}")))
+            (when-not-nil levels (<< "level must be either ~{levels}")))

 (def ^{:doc "Base config validation"} celestial-v
   {:celestial
-    {:port #{:required :number} :https-port #{:required :number}
-     :log {:level #{:required :levels} :path #{:required :String}}
-     :cert {:password #{:required :String} :keystore #{:required :String}}
-     :job {:expiry #{:number} :wait-time #{:number}}
-     :nrepl {:port #{:number}}}})
+   {:port #{:required :number} :https-port #{:required :number}
+    :log {:level #{:required :levels} :path #{:required :String}}
+    :cert {:password #{:required :String} :keystore #{:required :String}}
+    :job {:expiry #{:number} :wait-time #{:number}}
+    :nrepl {:port #{:number}}}})

 (validation :node*
-  (every-kv {:username #{:required :String} :password #{:required :String}
-             :host #{:required :String} :ssh-port #{:required :number}}))
+            (every-kv {:username #{:required :String} :password #{:required :String}
+                       :host #{:required :String} :ssh-port #{:required :number}}))

 (def flavors #{:redhat :debian})

 (validation :flavor
-  (when-not-nil flavors  (<< "flavor must be either ~{flavors}")))
+            (when-not-nil flavors  (<< "flavor must be either ~{flavors}")))

 (validation :template*
-  (every-kv {:template #{:required :String} :flavor #{:required :Keyword :flavor}}))
+            (every-kv {:template #{:required :String} :flavor #{:required :Keyword :flavor}}))
+

 (def ^{:doc "proxmox section validation"} proxmox-v
-  {:hypervisor {
-    :proxmox {
+  {:proxmox {
      :master #{:required :Keyword} :nodes #{:required :node*}
-     :ostemplates #{:template*}}}})
+     :ostemplates #{:template*}}})

 (def ^{:doc "aws section validation"} aws-v
-  {:hypervisor {:aws {:access-key #{:required :String} :secret-key #{:required :String}}}})
+  {:aws {:access-key #{:required :String} :secret-key #{:required :String}}})

 (def ^{:doc "vcenter section validation"} vcenter-v
-  {:hypervisor {
-    :vcenter {
+  {:vcenter {
       :url #{:required :String} :username #{:required :String}
       :password #{:required :String} :session-count #{:required :number}
-      :ostemplates #{:required :Map}
-     }}})
+      :ostemplates #{:required :Map} }})

 (defn validate-conf
   "applies all validations on a configration map"
   [{:keys [hypervisor] :as c}]
-  (let [{:keys [proxmox aws vcenter]} hypervisor]
-    (validate! c (combine base-v celestial-v (if proxmox proxmox-v {}) (if aws aws-v {}) (if vcenter vcenter-v {})))))
+  (let [hvs [proxmox-v aws-v vcenter-v] ks (map (comp first keys) hvs)
+        envs (map (fn [v] (fn [env] {:hypervisor {env v}})) hvs)]
+    (validate! c
+      (apply combine (into [base-v celestial-v]
+        (first (map (fn [[e hs]] (map #(((zipmap ks envs) %) e) (filter (into #{} ks) (keys hs)))) hypervisor)))))))

 (def config-paths
   ["/etc/celestial/celestial.edn" (<< "~(System/getProperty \"user.home\")/.celestial.edn")])
@@ -85,7 +86,7 @@
     (binding [*out* st]
       (clojure.pprint/pprint m))
     (set-config! [:shared-appender-config :spit-filename]
-          (get-in c [:celestial :log :path] "celestial.log"))
+                 (get-in c [:celestial :log :path] "celestial.log"))
     (set-config! [:appenders :spit :enabled?] true)
     (error "Following configuration errors found:\n" st)))


call-api can call a single API.

call-api can call a single API.

--- src/clj/darzana/core.clj
+++ src/clj/darzana/core.clj
@@ -81,8 +81,9 @@
                 { "status"   (-> result :response deref :status)
                   "message" response}}}))))))

-(defn call-api [context apis]
-  (let [api-responses (call-api-internal context apis)]
+(defn call-api [context api]
+  (let [ apis (if (map? api) [api] api)
+         api-responses (call-api-internal context apis)]
     (assoc context :scope
       (reduce #(merge-with merge %1 %2) (context :scope) api-responses))))


+ utility fn to convert dataset schema to google big query schema

--- src/cljc/xvsy/utils.cljc
+++ src/cljc/xvsy/utils.cljc
@@ -1,6 +1,7 @@
 (ns xvsy.utils
   (:require [schema.core :as s]
             [clojure.walk]
+            [clojure.data.json]
             [clojure.set]))

 (defn css
@@ -258,3 +259,15 @@
 (defn translate
   [coordinates]
   (let [[x y] (->xy coordinates)] (str "translate(" (float x) "," (float y) ")")))
+
+(defn ->bq-schema
+  "Returns a google big query schema from the given dataset schema"
+  [s]
+  (->> s (map (fn [[col-name {type :type}]]
+                {:name col-name
+                 :type (cond
+                         (isa? type s/Str) "STRING"
+                         (isa? type s/Int) "INTEGER"
+                         (isa? type s/Bool) "BOOLEAN"
+                         (isa? type s/Num) "FLOAT")}))
+       clojure.data.json/write-str))


import Math

import Math

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -628,6 +628,7 @@
   (emitln "import (")
   (emitln "\t" (wrap-in-double-quotes "reflect"))
   (emitln "\t" (wrap-in-double-quotes "github.com/hraberg/cljs.go/js"))
+  (emitln "\t" (wrap-in-double-quotes "github.com/hraberg/cljs.go/js/Math"))
   (when-not (= name 'cljs.core)
     (emitln "\t" "." " " (wrap-in-double-quotes "github.com/hraberg/cljs.go/cljs/core")))
   (doseq [lib (distinct (into (vals requires) (vals uses)))]


Do not init! client side data

Do not init! client side data

--- src/cljs/gtfve/core.cljs
+++ src/cljs/gtfve/core.cljs
@@ -62,6 +62,5 @@
 ;; -------------------------
 ;; Initialize app
 (defn init! []
-  (data/init!)
   (hook-browser-navigation!)
   (reagent/render [current-page] (.getElementById js/document "app")))


Remove unused utils

Remove unused utils

--- src/cljs/virt/utils.cljs
+++ src/cljs/virt/utils.cljs
@@ -1,5 +0,0 @@
-(ns virt.utils)
-
-(defn in?
-  [seq elm]
-  (some #(= elm %) seq))


adjusting mount call to upstream standart

--- src/main/clojure/com/narkisr/mounter.clj
+++ src/main/clojure/com/narkisr/mounter.clj
@@ -25,7 +25,7 @@
   (alter-var-root #'*host* (fn [_] (identity host)))
   (alter-var-root #'*db* (fn [_] (identity db)))
   (bind-root)
-  (FuseMount/mountWithThreadGroup (into-array [path "-f"]) (com.narkisr.couch-fuse.) (creat-log) (java.lang.ThreadGroup. group)))
+  (FuseMount/mount (into-array [path "-f"]) (com.narkisr.couch-fuse.) (java.lang.ThreadGroup. group) (creat-log)))

 (defn -main [& args]
   (with-command-line args "Couchdb fuse filesystem 0.1"


Add TODO

Add TODO

--- src/qu/loader.clj
+++ src/qu/loader.clj
@@ -357,6 +357,7 @@
   These files are loaded in parallel."
   [dataset & {:keys [delete] :or {delete true}}]
   (log/info "Loading dataset" dataset)
+  ;; TODO show better error msg on failure to find dataset
   (let [dataset (name dataset)
         definition (read-definition dataset)
         dir (:dir definition)


Add blend-mode function. Move unbinary funciton to the end of core.clj.

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -584,18 +584,6 @@
   ([val] (PApplet/binary (int val)))
   ([val num-digits] (PApplet/binary (int val) (int num-digits))))

-(defn
-  ^{:require-binding false
-    :processing-name "unbinary()"
-    :category "Data"
-    :subcategory "Conversion"
-    :added "1.0"}
-    unbinary
-  "Unpack a binary string to an integer. See binary for converting
-  integers to strings."
-  [str-val]
-  (PApplet/unbinary (str str-val)))
-
 (def ^{:private true}
   blend-modes {:blend PApplet/BLEND
                :add PApplet/ADD
@@ -607,6 +595,7 @@
                :multiply PApplet/MULTIPLY
                :screen PApplet/SCREEN
                :overlay PApplet/OVERLAY
+               :replace PApplet/REPLACE
                :hard-light PApplet/HARD_LIGHT
                :soft-light PApplet/SOFT_LIGHT
                :dodge PApplet/DODGE
@@ -621,6 +610,8 @@
   blend
   "Blends a region of pixels from one image into another (or in itself
   again) with full alpha channel support.
+
+  Note: (blend-mode) function is recommended to use instead of this one.

   Available blend modes are:

@@ -701,6 +692,46 @@

 (defn
   ^{:requires-bindings true
+    :processing-name "blendMOde()"
+    :category "Color"
+    :subcategory "Pixels"
+    :added "2.0"}
+  blend-mode
+  "Blends the pixels in the display window according to the defined mode.
+  There is a choice of the following modes to blend the source pixels (A)
+  with the ones of pixels already in the display window (B):
+
+  Available blend modes are:
+
+  :blend      - linear interpolation of colours: C = A*factor + B
+  :add        - additive blending with white clip:
+                                            C = min(A*factor + B, 255)
+  :subtract   - subtractive blending with black clip:
+                                            C = max(B - A*factor, 0)
+  :darkest    - only the darkest colour succeeds:
+                                            C = min(A*factor, B)
+  :lightest   - only the lightest colour succeeds:
+                                            C = max(A*factor, B)
+  :difference - subtract colors from underlying image.
+  :exclusion  - similar to :difference, but less extreme.
+  :multiply   - Multiply the colors, result will always be darker.
+  :screen     - Opposite multiply, uses inverse values of the colors.
+  :replace    - the pixels entirely replace the others and don't utilize
+                alpha (transparency) values
+
+  Note: :hard-light, :soft-light, :dodge, :overlay, :dodge, :burn modes
+  are not supported by this function."
+  ([x y width height dx dy dwidth dheight mode]
+     (let [mode (resolve-constant-key mode blend-modes)]
+       (.blend (current-surface) (int x) (int y) (int width) (int height)
+               (int dx) (int dy) (int dwidth) (int dheight) (int mode))))
+  ([^PImage src x y width height dx dy dwidth dheight mode]
+     (let [mode (resolve-constant-key mode blend-modes)]
+       (.blend (current-surface) src (int x) (int y) (int width) (int height)
+               (int dx) (int dy) (int dwidth) (int dheight) (int mode)))))
+
+(defn
+  ^{:requires-bindings true
     :processing-name "blue()"
     :category "Color"
     :subcategory "Creating & Reading"
@@ -4063,6 +4094,17 @@
              (float x2) (float y2)
              (float x3) (float y3)))

+(defn
+  ^{:require-binding false
+    :processing-name "unbinary()"
+    :category "Data"
+    :subcategory "Conversion"
+    :added "1.0"}
+    unbinary
+  "Unpack a binary string to an integer. See binary for converting
+  integers to strings."
+  [str-val]
+  (PApplet/unbinary (str str-val)))

 (defn
   ^{:requires-bindings true


Lowercase

Lowercase

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -1002,12 +1002,12 @@
            (when (and (build-model/can-cancel? build) has-write-settings?)
              (forms/managed-button
                [:a.cancel-build
-                {:data-loading-text "Canceling"
-                 :title             "Cancel this build"
+                {:data-loading-text "canceling"
+                 :title             "cancel this build"
                  :on-click #(raise! owner [:cancel-build-clicked {:build-id build-id
                                                                   :vcs-url vcs-url
                                                                   :build-num build-num}])}
-                "Cancel Build"]))
+                "cancel build"]))
            (when has-write-settings?
              (om/build rebuild-actions {:build build :project project}))
            [:div.build-settings


Make artifact-node clickable if it's a directory, and be careful React's diffing algo blowing away subcomponents.

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -257,12 +257,13 @@
                                   (.preventDefault event)
                                   (.stopPropagation event)
                                   (om/update-state! owner [key :closed?] not)))]
-               [:li (when directory?
+               [:li (if directory?
                       [:div {:style    {:cursor  "pointer"
                                         :display "inline"}
-                             :on-click toggler} (if closed? "▼  " "▲  ")])
-                tag
-                [:div (when closed? {:style {:display "none"}})
+                             :on-click toggler}
+                       (if closed? "▼  " "▲  ") tag]
+                      tag)
+                [:div {:style (when closed? {:display "none"})}
                  (om/build artifacts-node
                            children
                            {:opts (assoc opts


post/savecontent.clj: removed old job

post/savecontent.clj: removed old job

--- src/org/altlaw/jobs/post/savecontent.clj
+++ src/org/altlaw/jobs/post/savecontent.clj
@@ -1,34 +0,0 @@
-(ns org.altlaw.jobs.post.savecontent
-  (:require [org.altlaw.util.hadoop :as h]
-            [org.altlaw.util.log :as log]
-            [org.altlaw.util.context :as context]
-            [org.altlaw.db.content :as content]))
-
-(h/setup-mapreduce)
-
-(defn my-map [docid doc]
-  (if (:html doc)
-    (do (h/counter "Put content")
-        (let [hash (content/put-content-string
-                    (:html doc) {"Content-Type" "text/html"})]
-          [[docid {:html_content_sha1 hash}]]))
-    (do (h/counter "No HTML")
-        (log/warn "No HTML for docid " docid)
-        nil)))
-
-(defn mapper-configure [this jobconf]
-  (context/use-hadoop-jobconf jobconf))
-
-(def mapper-map (partial h/standard-map my-map))
-
-(defn tool-run [this args]
-  (let [job (h/default-jobconf this)
-        outpath (Path. (h/job-path :post :savecontent))]
-    (.setJobName job "savecontent")
-    (FileInputFormat/setInputPaths job (h/job-path :analyze :merge))
-    (FileOutputFormat/setOutputPath job outpath)
-    (.delete (FileSystem/get job) outpath true)
-    (.setMapperClass job org.altlaw.jobs.post.savecontent_mapper)
-    (.setNumReduceTasks job 0)
-    (JobClient/runJob job))
-  0)


Refactoring

Refactoring

--- src/tick/core.clj
+++ src/tick/core.clj
@@ -164,12 +164,12 @@
   ([colls]
    (merge-timelines compare colls)))

-(defn schedule-next [clock next-time executor cb]
+(defn schedule-next [next-time {:keys [clock executor callback]}]
   (when next-time
     (let [dly (.until (.instant clock) next-time ChronoUnit/MILLIS)]
-      (.schedule executor ^Callable cb dly TimeUnit/MILLISECONDS))))
-
-(defn callback [state timeline clock trigger executor promise]
+      (.schedule executor ^Callable callback dly TimeUnit/MILLISECONDS))))
+
+(defn callback [state timeline {:keys [clock trigger executor promise] :as opts}]
   (let [[due next-timeline] (split-with #(not (.isAfter (.toInstant %) (.instant clock))) timeline)]

     (if-not (empty? next-timeline)
@@ -177,7 +177,10 @@
       (do
         (swap! state assoc
                :timeline next-timeline
-               :scheduled-future (schedule-next clock (first next-timeline) executor #(callback state next-timeline clock trigger executor promise)))
+               :scheduled-future (schedule-next (first next-timeline)
+                                                {:clock clock
+                                                 :executor executor
+                                                 :callback #(callback state next-timeline opts)}))
         (dorun (map trigger due)))

       ;; Set status to :done
@@ -204,10 +207,10 @@
            :status :running
            :timeline timeline
            :scheduled-future (schedule-next
-                              clock
                               (first timeline)
-                              executor
-                              #(callback state timeline clock trigger executor promise))
+                              {:clock clock
+                               :executor executor
+                               :callback #(callback state timeline {:clock clock :trigger trigger :executor executor :promise promise})})
            :clock clock
            :executor executor)
     promise)
@@ -227,10 +230,11 @@
               clock (:clock st)]
           (swap! state (fn [st] (-> st (assoc :status :running
                                               :scheduled-future (schedule-next
-                                                                 clock
                                                                  (first timeline)
-                                                                 executor
-                                                                 #(callback state timeline clock trigger executor promise)))))))
+                                                                 {:clock clock
+                                                                  :executor executor
+                                                                  :callback #(callback state timeline {:clock clock :trigger trigger :executor executor :promise promise})}))))))
+
         :ok)))

   (stop [_]


Remove useless call to merge (#246)

Remove useless call to merge (#246)

--- src/yada/util.clj
+++ src/yada/util.clj
@@ -235,8 +235,6 @@
   (when (some identity maps)
     (reduce #(conj* (or %1 {}) %2) maps)))

-(merge)
-
 (defn expand
   "Expands the set keys and returns a map
   (expand {#{200 300} :test}) => {200 :test 300 :test}"


proxmox cloning spec

proxmox cloning spec

--- test/celestial/integration/workflows/proxmox.clj
+++ test/celestial/integration/workflows/proxmox.clj
@@ -4,6 +4,7 @@
     [celestial.fixtures.core :refer (with-defaults is-type?)]
     [celestial.fixtures.data :refer
      (redis-type redis-prox-spec local-conf)]
+    [celestial.persistency.systems :as s]
     [celestial.fixtures.populate :refer (populate-system)]
     [celestial.workflows :as wf])
   (:import clojure.lang.ExceptionInfo)
@@ -21,7 +22,15 @@
     (fact "proxmox reload workflows" :integration :proxmox :workflow
         (wf/create (spec)) => nil
         (wf/reload (spec)) => nil
-        (wf/destroy (spec)) => nil)))
+        (wf/destroy (spec)) => nil)
+
+    (fact "proxmox clone workflows" :integration :docker :workflow
+        (wf/create (spec)) => nil
+        (wf/clone 1
+          {:hostname "bar" :owner "ronen" :machine {:ip "192.168.21.253"}}) => nil
+        (wf/destroy (assoc (s/get-system 2) :system-id 2)) => nil
+        (wf/destroy (spec)) => nil)
+    ))


CMR-2564 add test for users not in managing group

--- access-control-app/int_test/cmr/access_control/int_test/access_control_group_crud_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/access_control_group_crud_test.clj
@@ -10,7 +10,7 @@

 (use-fixtures :each
               (fixtures/int-test-fixtures)
-              (fixtures/reset-fixture {"prov1guid" "PROV1" "prov2guid" "PROV2"} ["user1" "user2"])
+              (fixtures/reset-fixture {"prov1guid" "PROV1" "prov2guid" "PROV2"} ["user1" "user2" "user3"])
               (fixtures/grant-all-group-fixture ["prov1guid" "prov2guid"])
               (fixtures/grant-all-acl-fixture))

@@ -161,13 +161,14 @@
         (is (= {:status 200 :body ["user1" "user2"]} (u/get-members token concept_id)))))

     (testing "Attempt to create group with non-existent members"
-      (let [{:keys [status errors]} (create-group-with-members ["user1" "user3"])]
+      (let [{:keys [status errors]} (create-group-with-members ["user1" "user4"])]
         (is (= 400 status))
-        (is (= ["The following users do not exist [user3]"] errors))))))
+        (is (= ["The following users do not exist [user4]"] errors))))))

 (deftest create-group-with-managing-group-id-test
   (let [token-user1 (e/login (u/conn-context) "user1")
         token-user2 (e/login (u/conn-context) "user2")
+        token-user3 (e/login (u/conn-context) "user3")
         managing-group (u/ingest-group token-user1 {:name "managing group"} ["user1"])
         managing-group-id (:concept_id managing-group)
         create-group-with-managing-group
@@ -193,14 +194,15 @@
         ;; the group starts with no members
         (is (= {:status 200 :body []} (u/get-members token-user1 concept_id)))

-        ;; TODO: Once we add support to update group in ECHO and refresh access control cache,
-        ;; We can verify that user not in managing group does not have permission to add member to the group.
-        ; (is (= 401 (:status (u/add-members token-user2 concept_id ["user2"]))))
-
         ;; Add members to the group as a user in the managing group
         (is (= 200 (:status (u/add-members token-user1 concept_id ["user2"]))))
         ;; verify that the group now has a member added
-        (is (= {:status 200 :body ["user2"]} (u/get-members token-user1 concept_id)))))
+        (is (= {:status 200 :body ["user2"]} (u/get-members token-user1 concept_id)))
+
+        ;; Verify that user not in managing group does not have permission to add member to the group.
+        (e/ungrant (u/conn-context) {:id "guid4"})
+        (ac/clear-cache (u/conn-context))
+        (is (= 401 (:status (u/add-members token-user3 concept_id ["user3"]))))))

     (testing "Attempt to create group with non-existent managing group id"
       (let [{:keys [status errors]} (create-group-with-managing-group "group2" "AG10000-PROV1")]


Make open work on deferred blocks.

Make open work on deferred blocks.

--- src/blocks/core.clj
+++ src/blocks/core.clj
@@ -34,9 +34,14 @@

 (defn open
   "Opens an input stream to read the content of the block."
+  ^InputStream
   [block]
-  (when-let [content (:content block)]
-    (.open ^PersistentBytes content)))
+  (if-let [content (:content block)]
+    (.open ^PersistentBytes content)
+    (if-let [reader (:reader block)]
+      (reader)
+      (throw (IllegalArgumentException.
+               "Cannot open block with no content or reader.")))))

 (defn read!


Also sort output by card order

Also sort output by card order

--- src/clj/collect_earth_online/db/projects.clj
+++ src/clj/collect_earth_online/db/projects.clj
@@ -752,9 +752,10 @@

 (defn- sort-questions [survey-questions]
   (append-children survey-questions
-                   (filter (fn [[_id question]]
-                             (= -1 (:parentQuestionId question)))
-                           survey-questions)))
+                   (->> survey-questions
+                        (filter (fn [[_id question]]
+                                  (= -1 (:parentQuestionId question))))
+                        (sort-by #(get-in % [1 :cardOrder])))))

 ;;;
 ;;; Dump aggregate


make play circle work on artist detail

make play circle work on artist detail

--- src/cljs/cljspazzer/client/views/albums.cljs
+++ src/cljs/cljspazzer/client/views/albums.cljs
@@ -1,10 +1,12 @@
 (ns cljspazzer.client.views.albums
+  (:require-macros [cljs.core.async.macros :refer [go]])
   (:require [cljspazzer.client.utils :as utils]
             [cljspazzer.client.channels :as channels]
             [cljspazzer.client.views.artists :as artists]
             [cljspazzer.client.views.tracks :as tracks]
             [cljspazzer.client.views.nav :as nav]
             [cljspazzer.client.channels :as channels]
+            [cljspazzer.client.services :as services]
             [cljs.core.async :refer [<! put! chan]]))

 (defn mk-album-url [artist album]
@@ -27,12 +29,17 @@
         album-year (album "year")
         album-image (mk-album-image artist album)
         album-label (utils/format "%s" (album "album"))
-        album-zip-url (mk-album-zip-url artist album)]
+        album-zip-url (mk-album-zip-url artist album)
+        play-album (fn [e]
+                    (go
+                      (let [album-detail (<! (services/album-detail artist (album "album")))
+                            tracks ((album-detail "album") "tracks")]
+                        (put! channels/track-list [tracks 0]))))]
     [:li.no-select
       [:a
         [:img {:src album-image}] album-label album-year]
       [:div.album-actions
-        [:i.fa.fa-play-circle]
+        [:i.fa.fa-play-circle {:on-click play-album}]
         [:a [:i.fa.fa-plus-circle.fa-lg]]
         [:a {:href album-url} [:i.fa.fa-search.fa-lg]]
         [:a.download {:href album-zip-url}


Minor namespace fix.

Minor namespace fix.

--- src/cmr/index_set/services/index_service.clj
+++ src/cmr/index_set/services/index_service.clj
@@ -12,7 +12,7 @@
             [clojurewerkz.elastisch.rest.index :as esi]
             [cmr.index-set.config.elasticsearch-config :as es-config]
             [cmr.system-trace.core :refer [deftracefn]])
-  (import clojure.lang.ExceptionInfo))
+  (:import clojure.lang.ExceptionInfo))

 ;; configured list of cmr concepts
 (def cmr-concepts [:collection :granule])


Add doc strings.

Add doc strings.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -313,6 +313,7 @@
          :read (*read-factory* options#)))))

 (defn create-embedded-read-fn
+  "This creates a read fn intended for use in the embedded CLI."
   [opts in-chan]
   (let [rdr-fn (create-repl-read-fn opts)]
     (fn [request-prompt request-exit]
@@ -325,6 +326,17 @@
           request-prompt)))))

 (defmacro embedded-cli-fn
+  "Create an embedded CLI.
+   The embedded CLI is different from the classical CLI that can be created via start-cli
+   in the sense that does not aim at providing an interactive CLI that can be used via a command prompt.
+   An example for a use case of the embedded CLI is as part of a client-server application for which commands
+   can be executed, e.g., remotely on the server from the client.
+   For such use cases, the embedded CLI aims on easing the CLI definition similarly to start-cli.
+
+   This macro accepts the same options map as start-cli.
+   It will return a function that accepts string input.
+   The returned function accepts a single string argument that corresponds to the CLI input.
+   It returns the string resulting from evaluating the provided input."
   [user-options]
   `(let [out-wrtr# (atom (java.io.StringWriter.))
          out-chan# (async/chan)


Convert to options

Convert to options

--- metrics-clojure-ring/src/metrics/ring/expose.clj
+++ metrics-clojure-ring/src/metrics/ring/expose.clj
@@ -87,7 +87,7 @@
      (serve-metrics request default-registry))
   ([request registry]
      (serve-metrics request registry false))
-  ([request registry pretty-print?]
+  ([request registry {:keys [pretty-print?] :as opts}]
      (let [metrics-map (into {} (map render-metric (all-metrics registry)))
            json        (generate-string metrics-map {:pretty pretty-print?})]
        (-> (response json)
@@ -99,11 +99,11 @@
   ([handler uri]
     (expose-metrics-as-json handler uri default-registry))
   ([handler uri registry]
-    (expose-metrics-as-json handler uri default-registry false))
-  ([handler uri registry pretty-print?]
+    (expose-metrics-as-json handler uri default-registry {:pretty-print? false}))
+  ([handler uri registry opts]
     (fn [request]
       (let [request-uri (:uri request)]
         (if (or (.startsWith request-uri (sanitize-uri uri))
                 (= request-uri uri))
-          (serve-metrics request registry pretty-print?)
+          (serve-metrics request registry opts)
           (handler request))))))


missed change

missed change

--- src/structural_typing/api/predicates.clj
+++ src/structural_typing/api/predicates.clj
@@ -12,7 +12,7 @@
          (->> (partial >= 3) (show-as \"less than 3\"))
 "
   (when (fn? name) (frob/boom "First arg is a function. You probably got your args reversed."))
-  (when-not (string? name) (frob/boom "First arg must be a string: %s %s" name f))
+  (when-not (string? name) (frob/boom "First arg must be a string: %s %s" name predicate))
   (-> predicate
       lift/stash-defaults
       (lift/replace-predicate-string name)))


Fixed Ref Import

Fixed Ref Import

--- src/lens/import.clj
+++ src/lens/import.clj
@@ -52,12 +52,16 @@
       (update :count dec)))

 (defn- create-item-group-ref-job [defs ref]
+  (log/trace "create-item-group-ref-job:" ref)
   (let [form-def (get-in defs [:form-defs (:form-def-id ref)])]
+    (assert form-def)
     (->> (async/chan 1 (assoc-xf :type :item-group-ref))
          (async/pipe (api/create-item-group-ref! form-def ref)))))

 (defn- create-item-ref-job [defs ref]
+  (log/trace "create-item-ref-job:" ref)
   (let [item-group-def (get-in defs [:item-group-defs (:item-group-def-id ref)])]
+    (assert item-group-def)
     (->> (async/chan 1 (assoc-xf :type :item-ref))
          (async/pipe (api/create-item-ref! item-group-def ref)))))

@@ -108,24 +112,25 @@
   (update state :jobs #(remove-job % :item-group port)))

 (defn handle-item-group-def-job [state port val]
+  (log/trace "handle-item-group-def-job:" (:id (:data val)))
   (let [create-ref (map #(create-item-group-ref-job (get-in state [:defs (:study-id val)]) %))
-        ref-vec [(:study-id val) :item-group-refs (:id (:data val))]
-        ref-jobs (eduction create-ref (get-in state [:refs ref-vec]))]
+        ref-vec [:refs (:study-id val) :item-group-refs (:id (:data val))]
+        ref-jobs (eduction create-ref (get-in state ref-vec))]
     (-> (update state :jobs #(-> (remove-job % :item-group port)
                                  (add-jobs :item-group ref-jobs)))
         (update :defs #(collect-item-group-def % val))
-        (update :refs #(dissoc-in % ref-vec)))))
+        (dissoc-in ref-vec))))

 (defn handle-item-ref-job [state port _]
   (update state :jobs #(remove-job % :item port)))

 (defn handle-item-def-job [state port val]
-  (let [create-ref (map #(create-item-ref-job (get-in state [:defs (:study-id val)]) %))
-        ref-vec [(:study-id val) :item-refs (:id (:data val))]
-        ref-jobs (eduction create-ref (get-in state [:refs ref-vec]))]
+  (let [create-ref (map (fn [ref] (create-item-ref-job (get-in state [:defs (:study-id val)]) ref)))
+        ref-vec [:refs (:study-id val) :item-refs (:id (:data val))]
+        ref-jobs (eduction create-ref (get-in state ref-vec))]
     (-> (update state :jobs #(-> (remove-job % :item port)
                                  (add-jobs :item ref-jobs)))
-        (update :refs #(dissoc-in % ref-vec)))))
+        (dissoc-in ref-vec))))

 (defn- job-handler [type]
   (case type
@@ -137,7 +142,12 @@
     :item-ref handle-item-ref-job
     :item-def handle-item-def-job))

-(defn import! [service-document n parse-ch]
+(defn import!
+  "Returns a channel which closes after the import finished.
+
+  Puts an ExceptionInfo onto the channel if there is any problem. Fails fast on
+  the first problem."
+  [service-document n parse-ch]
   (let [constrain-jobs
         (fn [state]
           (if (< (:count (:jobs state)) n) [parse-ch] []))]
@@ -147,14 +157,17 @@
                      :defs {}
                      :refs {}}]
       (let [[val port] (async/alts! (into ports (select-jobs (:jobs state))))]
-        (if-let [type (:type val)]
-          (if (= parse-ch port)
-            (if (= :study type)
-              (recur [] (handle-study state val))
-              (recur (constrain-jobs state) ((handler type) state val)))
-            (recur (constrain-jobs state) ((job-handler type) state port val)))
+        (if (instance? Throwable val)
+          val
+          (if-let [type (:type val)]
+            (if (= parse-ch port)
+              (if (= :study type)
+                (recur [] (handle-study state val))
+                (recur (constrain-jobs state) ((handler type) state val)))
+              (recur (constrain-jobs state) ((job-handler type) state port val)))

-          (if (= 0 (:count (:jobs state)))
-            (log/info "Finished!")
-            (recur [] state)))))))
-
+            (if (= 0 (:count (:jobs state)))
+              (if (empty? (:refs state))
+                (log/info "Finished!")
+                (throw (ex-info (str "Unresolved refs: " (:refs state)) {:refs (:refs state)})))
+              (recur [] state))))))))


Elaborate on some of the FIXMEs

Elaborate on some of the FIXMEs

and delegate some of the Problems to other places. It cannot be the
responsibility of the abacus export to determine the number of volumes
for example. Such data just has to be passed in.

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -95,15 +95,26 @@
 (defn export
   "Export the state of a production as a csv-like structure, ready to
   be consumed by ABACUS"
-  [{:keys [productNumber totalTime state audioFormat multimediaType date id] :as production}]
+  [{:keys [productNumber totalTime state audioFormat multimediaType
+           date id producedDate volumes] :as production}]
   (->> [(create-row 2 productNumber)
         (create-row 233 totalTime) ; in minutes
         (create-row 106 state) ; Process Status Madras
+        ;; FIXME: what exactly is the document status? In what way is
+        ;; it different than the process status? In my view there is
+        ;; only one state and that is the state of the production. Is
+        ;; the production ready for recording, is it waiting for
+        ;; volume splitting, etc?
         (create-row 107 :FIXME) ; Document Status Madras
         (create-row 276 audioFormat)
-        (create-row 275 :FIXME) ; Number of CDs
+        ;; FIXME: the number of CDs is only determined at the time of
+        ;; archiving. Is this persisted in the db?
+        (create-row 275 volumes ; Number of CDs
         (create-row 277 multimediaType)
-        (create-row 252 :FIXME) ; Date of production end
+        ;; FIXME: again the date of the end of the production is only
+        ;; known once we start the archiving. Should this be persisted
+        ;; to the db?
+        (create-row 252 producedDate) ; Date of production end
         (create-row 274 date) ; Date of production start
         (create-row 4 (production/dam-number production))] ; for legacy purposes
        (remove nil?) ; remove empty rows


convenience spec macros

convenience spec macros

--- dev/spec.clj
+++ dev/spec.clj
@@ -5,9 +5,16 @@

 (alter-var-root #'type/hierarchy type/add-custom-types [:body :fixture :coord :snapshot])

-(defn opts [& keys]
-  (fn [{:keys [options]}]
-    (select-keys options keys)))
+(defmacro options-spec [& keys]
+  `(spec/? (spec/and (spec/keys :opt-un ~(vec keys))
+                     (spec/conformer (fn [value#]
+                                       (select-keys value# ~(->> keys
+                                                                 (map (comp keyword name))
+                                                                 (vec))))))))
+
+(defmacro composite-spec [& fields]
+  `(spec/and (spec/cat :schema keyword? ~@fields)
+             (spec/conformer (juxt ~@(take-nth 2 fields)))))

 (spec/def ::pre
   symbol?)
@@ -36,77 +43,65 @@
   (spec/spec (constantly true)))

 (defmethod spec-type :list [_]
-  (spec/and (spec/cat :symbol  #{:list}
-                      :options (spec/? map?)
-                      :schema  ::schema)
-            (spec/conformer (juxt :symbol (opts) :schema))))
+  (composite-spec :options (options-spec)
+                  :schema  ::schema))

 (defmethod spec-type :vector [_]
-  (spec/and (spec/cat :symbol  #{:vector}
-                      :options (spec/? map?)
-                      :schema  ::schema)
-            (spec/conformer (juxt :symbol (opts) :schema))))
+  (composite-spec :options (options-spec)
+                  :schema  ::schema))

 (defmethod spec-type :set [_]
-  (spec/and (spec/cat :symbol  #{:set}
-                      :options (spec/? (spec/keys :opt-un [::sorted-by]))
-                      :schema  ::schema)
-            (spec/conformer (juxt :symbol (opts :sorted-by) :schema))))
+  (composite-spec :options (options-spec ::sorted-by)
+                  :schema  ::schema))

 (defmethod spec-type :map [_]
-  (spec/and (spec/cat :symbol     #{:map}
-                      :options    (spec/? (spec/keys :opt-un [::sorted-by]))
-                      :key-schema ::schema
-                      :val-schema ::schema)
-            (spec/conformer (juxt :symbol (opts :sorted-by) :key-schema :val-schema))))
+  (composite-spec :options    (options-spec ::sorted-by)
+                  :key-schema ::schema
+                  :val-schema ::schema))

 (defmethod spec-type :tuple [_]
-  (spec/and (spec/cat :symbol  #{:tuple}
-                      :options (spec/? map?)
-                      :schemas (spec/coll-of ::schema []))
-            (spec/conformer (juxt :symbol (opts) :schema))))
+  (composite-spec :options (options-spec)
+                  :schemas (spec/coll-of ::schema [])))

 (defmethod spec-type :record [_]
-  (spec/and (spec/cat :symbol  #{:record}
-                      :options (spec/? (spec/keys :opt-un [::constructor]))
-                      :schemas (spec/map-of keyword? ::schema))
-            (spec/conformer (juxt :symbol (opts :constructors) :schemas))))
+  (composite-spec :options (options-spec ::constructor)
+                  :schemas (spec/map-of keyword? ::schema)))

 (defmethod spec-type :optional [_]
-  (spec/and (spec/cat :symbol  #{:optional}
-                      :options (spec/? map?)
-                      :schema  ::schema)
-            (spec/conformer (juxt :symbol (opts) :schemas))))
+  (composite-spec :options (options-spec)
+                  :schema  ::schema))

 (defmethod spec-type :enum [_]
-  (spec/and (spec/cat :symbol  #{:enum}
-                      :options (spec/? map?)
-                      :values  (spec/coll-of keyword? []))
-            (spec/conformer (juxt :symbol (opts) :values))))
+  (composite-spec :options (options-spec)
+                  :values  (spec/coll-of keyword? [])))

 (defmethod spec-type :multi [_]
-  (spec/and (spec/cat :symbol   #{:multi}
-                      :options  (spec/? map?)
-                      :selector symbol?
-                      :schemas  (spec/map-of (constantly true) ::schema))
-            (spec/conformer (juxt :symbol (opts) :selector :schemas))))
+  (composite-spec :options (options-spec)
+                  :selector symbol?
+                  :schemas  (spec/map-of (constantly true) ::schema)))

 (defmethod spec-type :wrapped [_]
-  (spec/and (spec/cat :symbol  #{:wrapped}
-                      :pre     symbol?
-                      :post    symbol?
-                      :schema  ::schema)
-            (spec/conformer (juxt :symbol (opts) :pre :post :schemas))))
+  (composite-spec :options (options-spec)
+                  :pre     symbol?
+                  :post    symbol?
+                  :schema  ::schema))

 (defmethod spec-type :clojure.spec/invalid [_]
   nil)

-(spec/def ::schema (spec/multi-spec spec-type util/type-of))
+(spec/def ::schema
+  (spec/multi-spec spec-type util/type-of))

-(spec/def ::schemas (spec/and (spec/map-of keyword? ::schema)
-                              (fn [schemas]
-                                 (not-any? #(isa? type/hierarchy % :built-in)
-                                           (keys schemas)))))
+(spec/def ::schemas
+  (spec/and (spec/map-of keyword? ::schema)
+            (fn [schemas]
+               (not-any? #(isa? type/hierarchy % :built-in)
+                         (keys schemas)))))
+
+(spec/def ::options
+  (spec/keys :opt-un [::schemas]))
+
+;; PLAYGROUND

 (spec/conform ::schemas
   {:body     [:record {:user-data [:record {:id :int}]
@@ -120,27 +115,5 @@
    :snapshot [:record {:time   :long
                        :bodies [:list :body]}]})

-;; PLAYGROUND
-
-(spec/conform ::schema
-              [:record {:user-data [:record {:id :int}]
-                        :position  :coord
-                        :angle     :float
-                        :body-type [:enum [:dynamic :static :kinetic]]
-                        :fixtures  [:list :fixture]}])
-
-(spec/conform (spec/map-of keyword? ::schema)
-              {:body [:set [:list :int]]})
-
-(spec/conform (spec/and (spec/coll-of ::schema [])
-                        (spec/conformer identity))
-              [[:set [:list :int]]])
-
-(spec/conform ::schema [:set {:sorted-by 'adf} :int])
-
-(spec/conform (spec/cat :u (spec/and integer?
-                                     (spec/conformer (constantly nil))))
-              [1])
-
-(spec/conform (spec/and integer? (spec/conformer (constantly nil)))
-              10)
+;; ISSUES
+;; conform does not flow into coll-of / map-of


don't use midje's autotest, use manual (load-facts)

autotests reloading does not play nice with a development system in the same repl

--- dev/user.clj
+++ dev/user.clj
@@ -14,7 +14,7 @@
             [dev-data :as d]
             [taoensso.timbre :as timbre]
             [taoensso.timbre.appenders (socket :as socket-appender)]
-            [midje.repl :refer [autotest]]
+            [midje.repl :refer [load-facts]]
             [midje.config :as midje.config]
             [com.stuartsierra.component :as component]))

@@ -52,8 +52,13 @@
   []
   (init)
   (start)
-  (autotest)
   :ok)
+
+(defn run-tests
+  "Runs tests against the codebase."
+  []
+  (load-facts)
+  (timbre/warn "Tests have been run. Current development system is hosed, use (reset) to recover"))

 (defn reset []
   (stop)


CMR-2887: Removed unnecessary ACL not found check.

--- access-control-app/src/cmr/access_control/services/acl_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_service.clj
@@ -93,7 +93,7 @@
   ;; This fetch acl call also validates if the ACL with the concept id does not exist or is deleted
   (fetch-acl-concept context concept-id)
   (let [native-id (acl-native-id acl)]
-    (if-let [existing-concept-id (mdb/get-concept-id context :acl acl-provider-id (acl-native-id acl))]
+    (when-let [existing-concept-id (mdb/get-concept-id context :acl acl-provider-id (acl-native-id acl))]

       ;; The acl exists. Check if its latest revision is a tombstone
       (let [concept (mdb/get-latest-concept context existing-concept-id)
@@ -113,11 +113,7 @@
               (mdb/save-concept context (dissoc (acl->new-concept context acl) :revision-id)))
             (errors/throw-service-error
               :conflict (format "ACL with native id [%s] already exists with concept id [%s]"
-                                native-id existing-concept-id)))))
-
-      ;; The acl doesn't exist
-      (errors/throw-service-error
-        :not-found (format "ACL with concept id [%s] does not exist" concept-id)))))
+                                native-id existing-concept-id))))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Search functions


Redirect to multiaccounts only on explicit logout

Signed-off-by: Gheorghe Pinzaru <742a0a3885ab52ea1795e48e261ec4223e194612@gmail.com>

--- src/status_im/multiaccounts/logout/core.cljs
+++ src/status_im/multiaccounts/logout/core.cljs
@@ -9,12 +9,12 @@
             [status-im.ui.screens.navigation :as navigation]
             [status-im.utils.keychain.core :as keychain]))

-(fx/defn logout-method [{:keys [db] :as cofx} auth-method]
+(fx/defn logout-method [{:keys [db] :as cofx} {:keys [auth-method logout?]}]
   (let [key-uid (get-in db [:multiaccount :key-uid])]
     (fx/merge cofx
               {::logout                      nil
                :keychain/clear-user-password key-uid
-               ::init/open-multiaccounts     #(re-frame/dispatch [::init/initialize-multiaccounts % {:logout? true}])}
+               ::init/open-multiaccounts     #(re-frame/dispatch [::init/initialize-multiaccounts % {:logout? logout?}])}
               (keychain/save-auth-method key-uid auth-method)
               (transport/stop-whisper)
               (chaos-mode/stop-checking)
@@ -23,7 +23,8 @@
 (fx/defn logout
   {:events [:logout]}
   [cofx]
-  (logout-method cofx keychain/auth-method-none))
+  (logout-method cofx {:auth-method keychain/auth-method-none
+                       :logout?     true}))

 (fx/defn show-logout-confirmation [_]
   {:ui/show-confirmation
@@ -37,7 +38,8 @@
   {:events [:biometric-logout]}
   [cofx]
   (fx/merge cofx
-            (logout-method keychain/auth-method-biometric-prepare)
+            (logout-method {:auth-method keychain/auth-method-biometric-prepare
+                            :logout?     false})
             (fn [{:keys [db]}]
               {:db (assoc-in db [:multiaccounts/login :save-password?] true)})))


use a single fn to coerce/flatten keys

use a single fn to coerce/flatten keys

--- src/er_cassandra/key.clj
+++ src/er_cassandra/key.clj
@@ -19,8 +19,9 @@
       (vec ck))))

 (defn flatten-key
+  "coerce to a vector and remove any partition-key nesting"
   [key]
-  (-> key v/coerce flatten))
+  (some-> key v/coerce flatten vec))

 (defn extract-key-value
   "extract a key value from some combination of explicit value
@@ -30,10 +31,10 @@
    (extract-key-value key record-or-key-value {}))

   ([key record-or-key-value {:keys [key-value]}]
-   (let [key (flatten (v/coerce key)) ;; flatten partition key
-         key-value (or (v/coerce key-value nil)
+   (let [key (flatten-key key)
+         key-value (or (flatten-key key-value)
                        (if-not (map? record-or-key-value)
-                         (v/coerce record-or-key-value)
+                         (flatten-key record-or-key-value)
                          (repeat (count key) nil)))
          record (when (map? record-or-key-value)
                   record-or-key-value)
@@ -50,16 +51,19 @@
   "remove components from a [key key-value] pair, returning
    a new [key key-value] pair with the components removed"
   [key key-value remove-components]
-  (let [kvs (map vector (flatten (v/coerce key)) (v/coerce key-value))
-        rcs (set (v/coerce remove-components))
+  (let [kvs (map vector (flatten-key key) (flatten-key key-value))
+        rcs (set (flatten-key remove-components))
         fkvs (filter (fn [[k v]] (not (contains? rcs k)))
                      kvs)]
     (when (> (count fkvs) 0)
       [(map first fkvs) (map second fkvs)])))

 (defn key-equality-clause
+  "return a Hayt when clause for key and key-value... if
+   elements of key-value are lists then an :in clause will
+   be used instead of :="
   [key key-value]
-  (let [key (flatten (v/coerce key))
+  (let [key (flatten-key key)
         key-value (v/coerce key-value)]
     (mapv (fn [k v]
             (if (sequential? v)
@@ -124,7 +128,7 @@
   ([key record col-colls]
    (when-let [kv (not-empty
                   (extract-key-value key record {}))]
-     (let [key (flatten (v/coerce key))
+     (let [key (flatten-key key)
            col-values (mapv (fn [k v]
                               (extract-collection-key-components
                                col-colls
@@ -139,6 +143,6 @@
   "true if the record contains? keys for all the key components"
   [key record]
   (->> key
-       flatten
+       flatten-key
        (map #(contains? record %))
        (every? identity)))


Refactor tests

Refactor tests


Fix seq. safety test.

Fix seq. safety test.

--- test/onyx/coordinator/sim_test_utils.clj
+++ test/onyx/coordinator/sim_test_utils.clj
@@ -93,10 +93,12 @@
         (doseq [other-peer other-peers]
           (doseq [range-node range-nodes]
             (doseq [state (sort (extensions/children sync other-peer))]
-              (when (= (:task-node (extensions/read-node sync state)) (nth range-node 2))
-                (let [zxid (:czxid (:stat (zk/data (:conn sync) state)))]
-                  (fact (or (< zxid (first range-node))
-                            (> zxid (second range-node))) => true))))))))))
+              (let [status (extensions/read-node sync state)]
+                (when (= (:task-node status) (nth range-node 2))
+                  (let [zxid (:czxid (:stat (zk/data (:conn sync) state)))]
+                    (when-not (= (:state status) :dead)
+                      (fact (or (< zxid (first range-node))
+                                (> zxid (second range-node))) => true))))))))))))

 (defn peer-liveness [sync]
   (doseq [state-path (extensions/bucket sync :peer-state)]


Create tests for model util functions

Create tests for model util functions

--- test/text-justification/test/model_test.cljs
+++ test/text-justification/test/model_test.cljs
@@ -1,25 +1,58 @@
-;;(ns is-it-time.test.compare-test
 (ns text-justification.test.model-test
   (:require
-    [cljs.test :refer-macros [deftest testing is]]))
-  ;; require my own scripts too !
+    [cljs.test :refer-macros [deftest testing is]]
+    [text-justification.model :as model]))

-;;(deftest somewhat-less-wat
-  ;;(is (= "{}[]" (+ {} []))))
-  ;;(is (= "{}[]" (+ {} []))))

-; (deftest javascript-allows-div0
-  ; (is (= js/Infinity (/ 1 0) (/ (int 1) (int 0)))))
+(deftest badness
+  ;; test note: badness() should freak out with negative numbers, but for perf. reasons it is not implemented
+  ;; (ATM of writing profiler panics on has-memo? method with 3-6% time spend there)
+  (testing "lines longer then max allowed length"
+    (is (= js/Infinity (model/badness [41] 40)))
+    (is (= js/Infinity (model/badness [1]   0)))
+    (is (= js/Infinity (model/badness [20 20] 40))) ;; 40 chars + one space
+    (is (= js/Infinity (model/badness [13 13 13] 40))) )
+  (testing "lines of max allowed length"
+    (is (zero? (model/badness [40]   40)))
+    (is (zero? (model/badness [1]    1)))
+    (is (zero? (model/badness [0]    0)))
+    (is (zero? (model/badness [20 20] 41)))
+    (is (zero? (model/badness [13 13 13] 41))) )
+  (testing "cubes the difference between max line length and provided line"
+    (is (= 1 (model/badness [1]   2)))    ;; 1^3
+    (is (= 1  (model/badness [2]   3)))
+    (is (= 1  (model/badness [2 2] 6)))
+    (is (= 1  (model/badness [2 2 2] 9)))
+    (is (= 27 (model/badness [8] 11)))    ;; 3^3
+    (is (= 27 (model/badness [2 2] 8)))
+    (is (= 27 (model/badness [2 2 2] 11))) ))

-(deftest javascript-allows-div1
-  (is (= 1 (/ 1 0) (/ (int 1) (int 0)))))
+(deftest tj-inner
+  (testing "example provided by Erik Demaine"
+    ;; original example: "blah blah blah blah reallylongword"
+    ;; should be justified like this:
+    ;;   blah      blah
+    ;;   blah      blah
+    ;;   reallylongword
+    ;;
+    ;; (tj-inner operates on lengths of words and returns words per line)
+    (is (= [2 2 1] (model/tj-inner 14 [4 4 4 4 14]))) ))

-(comment
-(with-test
-  (defn pennies->dollar-string
-    [pennies]
-    {:pre [(integer? pennies)]}
-    (str "$" (int (/ pennies 100)) "." (mod pennies 100)))
-  (testing "assertions are nice"
-    (is (thrown-with-msg? js/Error #"integer?" (pennies->dollar-string 564.2)))))
-)
+(deftest split-word
+  (testing "words longer then max allowed length"
+    (is (= 2 (count (model/split-word 3 "1234"))))  ;; "123" " -4"
+    (is (= 3 (count (model/split-word 3 "12345")))) ;; "123" " -4" " -5"
+    (is (= 2 (count (model/split-word 11 "aaa___aaa___")))) ;; ?
+    (is (= 3 (count (model/split-word 11 "aaa___aaa___aaa___aaa___")))) ;; ?
+    (is (= 4 (count (model/split-word 11 "aaa___aaa___aaa___aaa___aaa___aaa___")))) ) ;; ?
+  (testing "words of max allowed length"
+    (is (= 1 (count (model/split-word 1 "a"))))
+    (is (= 1 (count (model/split-word 24 "aaa___aaa___aaa___aaa___")))) )
+  (testing "words shorter then allowed"
+    (is (= 1 (count (model/split-word 2 "a"))))
+    (is (= 1 (count (model/split-word 13 "aaa___aaa___")))) ))
+
+
+;; prepare-paragraph
+;; prepare-text
+;; text-justification


Mobile plugin, gallery search fix

Mobile plugin, gallery search fix

--- src/clj/salava/extra/mobile/db.clj
+++ src/clj/salava/extra/mobile/db.clj
@@ -136,30 +136,32 @@
        (str where (apply str (interpose " " name-where)))
        (into args (mapcat #(list % %) name-parts))])))

-(defn- gallery-badge-query [country name order offset]
+(defn- gallery-badge-query [country name]
   (let [[join where args] (-> ["INNER JOIN user_badge ub ON g.id = ub.gallery_id"
                                (str "WHERE ub.deleted = 0 AND ub.visibility != 'private'"
                                     " AND ub.revoked = 0 AND (ub.expires_on IS NULL OR ub.expires_on > UNIX_TIMESTAMP())")
                                []]
                               (gallery-badge-query-country country)
-                              (gallery-badge-query-name name))
+                              (gallery-badge-query-name name))]
+    [(str "FROM gallery g " join " " where) args]))
+
+
+(defn gallery-badge-search [ctx {:keys [country name order offset]}]
+  (let [[from-where args] (gallery-badge-query country name)
+
         order-by (if (= order "name") "ORDER BY g.badge_name" "ORDER BY ub.id DESC")
-        offset (if (re-find #"^[0-9]+$" offset) (str "OFFSET " (* 20 (Long. offset))) "OFFSET 0")]
-    [(str "FROM gallery g " join " " where " " order-by " LIMIT 20 " offset) args]))
-
-
-(defn gallery-badge-search [ctx {:keys [country name order offset]}]
-  (let [conn (:connection (u/get-db ctx))
-        [sql args] (gallery-badge-query country name order offset)
+        offset (if (re-find #"^[0-9]+$" offset) (str "OFFSET " (* 20 (Long. offset))) "OFFSET 0")
+
         sql-count (str "SELECT COUNT(g.id) as total "
-                       sql)
+                       from-where)
         sql-data  (str "SELECT g.id AS gallery_id, NULL as advert_id,"
                        " g.badge_id, g.badge_name, g.issuer_name, g.badge_image AS image_file "
-                       sql)]
+                       from-where  " " order-by " LIMIT 20 " offset)
+       conn (:connection (u/get-db ctx))]

     {:badges (->> (jdbc/query conn (into [sql-data] args))
                   (map #(update % :image_file (partial png-convert-url ctx))))
-     :total (-> (jdbc/query conn (into [sql-count] args)) first :total)}))
+     :total (-> (jdbc/query conn (into [sql-count] args)) first (get :total 0))}))

 ;;;

@@ -179,7 +181,7 @@
        (str where (apply str (interpose " " name-where)))
        (into args (mapcat #(list % % %) name-parts))])))

-(defn- gallery-earnable-badge-query [country name order offset]
+(defn- gallery-earnable-badge-query [country name]
   (let [[join where args] (-> [(str "INNER JOIN badge_content bc ON a.badge_content_id = bc.id "
                                     "INNER JOIN issuer_content ic ON a.issuer_content_id = ic.id")
                                (str "WHERE a.deleted = 0"
@@ -187,23 +189,25 @@
                                     " AND (a.not_after  IS NULL OR a.not_after  = 0 OR a.not_after  >= UNIX_TIMESTAMP())")
                                []]
                               (gallery-earnable-badge-query-country country)
-                              (gallery-earnable-badge-query-name name))
+                              (gallery-earnable-badge-query-name name))]
+    [(str "FROM badge_advert a " join " " where) args]))
+
+(defn gallery-earnable-badge-search [ctx {:keys [country name order offset]}]
+  (let [[from-where args] (gallery-earnable-badge-query country name)
+
         order-by (if (= order "name") "ORDER BY badge_name" "ORDER BY a.mtime DESC")
-        offset (if (re-find #"^[0-9]+$" offset) (str "OFFSET " (* 20 (Long. offset))) "OFFSET 0")]
-    [(str "FROM badge_advert a " join " " where " " order-by " LIMIT 20 " offset) args]))
-
-(defn gallery-earnable-badge-search [ctx {:keys [country name order offset]}]
-  (let [conn (:connection (u/get-db ctx))
-        [sql args] (gallery-earnable-badge-query country name order offset)
+        offset (if (re-find #"^[0-9]+$" offset) (str "OFFSET " (* 20 (Long. offset))) "OFFSET 0")
+
         sql-count (str "SELECT COUNT(a.id) as total "
-                       sql)
+                       from-where)
         sql-data  (str "SELECT NULL AS gallery_id, a.id as advert_id,"
                        " NULL AS badge_id, bc.name AS badge_name, ic.name AS issuer_name, bc.image_file "
-                       sql)]
+                       from-where " " order-by " LIMIT 20 " offset)
+        conn (:connection (u/get-db ctx))]

     {:badges (->> (jdbc/query conn (into [sql-data] args))
                   (map #(update % :image_file (partial png-convert-url ctx))))
-     :total (-> (jdbc/query conn (into [sql-count] args)) first :total)}))
+     :total (-> (jdbc/query conn (into [sql-count] args)) first (get :total 0))}))

 ;;;


wait for server util function

wait for server util function

--- src/clj/shadow/devtools/server.clj
+++ src/clj/shadow/devtools/server.clj
@@ -34,7 +34,7 @@
 (defmethod handle-client-msg :repl/out
   [client-state {:keys [out] :as msg}]
   (doseq [s out]
-    (println s))
+    (println (str "BROWSER: " s)))
   client-state)

 (defmethod handle-client-msg :repl/result
@@ -367,6 +367,13 @@
       (cljs/compile-modules)
       (cljs/flush-unoptimized)))

+(defn wait-for-server!
+  "blocks util the server shuts down and returns the last compiler-state"
+  [{:keys [server-loop] :as state}]
+  (when-not server-loop
+    (throw (ex-info "no server loop?" {})))
+  (<!! server-loop))
+
 (defn start
   ([state config]
    (start state config default-compile-callback))


export badge user email schema

export badge user email schema

--- src/cljc/salava/badge/schemas.cljc
+++ src/cljc/salava/badge/schemas.cljc
@@ -154,9 +154,12 @@
                               :url s/Str
                               :markdown_text (s/maybe s/Str)})

+(s/defschema UserBackpackEmail {:email s/Str
+                                :backpack_id (s/maybe s/Int)})

+


Stop from-parent triggering from-child pieces WIP

I've managed to break the echo test somewhere in the past few
commits (which I really did all in one fell swoop...I just broke them
into smaller pieces to make it easier for me to remember what each
change was for), and this seems like the most likely culprit.

It also broke my "stop message loop" functionality: while I've been
writing these commits, I see it triggering once a minute.

This is definitely a right thing to do, even though I have the details wrong.

--- src/clojure/frereth_cp/message.clj
+++ src/clojure/frereth_cp/message.clj
@@ -138,24 +138,26 @@
   ;; send to actually get through the queue
   (let [min-resend-time (+ last-block-time n-sec-per-block)
         _ (log/debug (cl-format nil
-                                "~a: Minimum resend time: ~:d which is ~:d nanoseconds after ~:d"
+                                "~a: Minimum resend time: ~:d which is ~:d nanoseconds after ~:d (contrast w/ ~:d)"
                                 message-loop-name
                                 min-resend-time
                                 n-sec-per-block
-                                ;; last-block-time causes problems.
-                                ;; Up until the point I've sent my
-                                ;; last block, it basically progresses
-                                ;; linearly up to 1907725432157608
-                                ;; (for tonight's debug session).
-                                ;; Then it jumps down to
-                                ;; 1907725404755660, which leaves
-                                ;; me with negative delays, because
-                                ;; I'm trying to send the next send
-                                ;; in the past.
-                                ;; And doing this every millisecond
-                                ;; leads to its own set of problems.
-                                ;; FIXME: Start back here.
-                                last-block-time))
+                                ;; I'm calculating last-block-time
+                                ;; incorrectly, due to a misunderstanding
+                                ;; about the name.
+                                ;; It should really be the value of
+                                ;; recent, set immediately after
+                                ;; I send a block to parent.
+                                last-block-time
+                                ;; Extracting this here seems
+                                ;; wasteful. And useless, if
+                                ;; there are no un-ackd-blocks.
+                                ;; The latter consideration
+                                ;; is why I *have* to track
+                                ;; last-block-time separately.
+                                (-> un-ackd-blocks
+                                    last
+                                    ::specs/time)))
         default-next (+ recent (utils/seconds->nanos 60))
         _ (log/debug (cl-format nil
                                 "~a: Default +1 minute: ~:d from ~:d"
@@ -219,11 +221,14 @@
     actual-next))

 (declare trigger-from-timer)
+(s/fdef schedule-next-timeout!
+        :args (s/cat :state ::specs/state
+                     :state-agent ::specs/state-agent)
+        :ret ::specs/state)
 (defn schedule-next-timeout!
   [{:keys [::specs/message-loop-name
            ::specs/recent]
-    {:keys [::specs/next-action
-            ::specs/schedule-pool]
+    {:keys [::specs/next-action]
      :as flow-control} ::specs/flow-control
     :as state}
    state-agent]
@@ -406,26 +411,21 @@
   ;; actually calling this.
   (let [state
         (as-> state state
-            (assoc state ::specs/recent (System/nanoTime))
-            (to-parent/maybe-send-block! state)
-            ;; The message from parent to child was garbage.
-            ;; Discard.
-            ;; Q: Does this make sense?
-            ;; It leaves our "global" state updated in a way that left us unable
-            ;; to send earlier. That isn't likely to get fixed the next time
-            ;; through the event loop.
-            ;; (I'm hitting this because I'm sending a gibberish message that
-            ;; needs to be discarded)
-
-            ;; It seems like I should be able to skip this if we got triggered
-            ;; by anything except an incoming message from the parent.
-            ;; That is misleading. We still need to cope with any messages
-            ;; from the parent that haven't been written to the child yet.
-            ;; And, realistically, we *should* cope with message blocks that
-            ;; have only partially been written
-            (or (from-parent/try-processing-message! state)
-                state)
-            (to-child/forward! ->child state))]
+          (assoc state ::specs/recent (System/nanoTime))
+          ;; It doesn't make any sense to call this if
+          ;; we were triggered by a message coming in from
+          ;; the parent.
+          ;; Even if there are pending blocks are ready to
+          ;; send, outgoing messages are throttled by
+          ;; the flow-control logic.
+          ;; Likewise, there isn't a lot of sense in
+          ;; calling it from the child, due to the same
+          ;; throttling issues.
+          ;; Unless we're just idling along, checking for
+          ;; resends every second. Which should only happen
+          ;; if there *are* blocks to resend.
+          ;; This still needs more consideration.
+          (to-parent/maybe-send-block! state))]
     ;; At the end of the main ioloop in the refernce
     ;; implementation, there's a block that closes the pipe
     ;; to the child if we're done.
@@ -434,6 +434,7 @@
     ;; that might do the send, once we've hit EOF
     ;; Q: What can I do here to
     ;; produce the same effect?
+    ;; TODO: Worry about that once the basic idea works.

     ;; If the child sent a big batch of data to go out
     ;; all at once, don't waste time setting up a timeout
@@ -461,19 +462,11 @@
     :keys [::specs/message-loop-name]
     :as state}
    array-o-bytes]
-  (log/debug (str message-loop-name
-                  ": trigger-from-child Received a "
-                  (class array-o-bytes)
-                  "\nSent stream address: "
-                  send-bytes))
-  (when-not send-bytes
-    (log/error (str message-loop-name
-                    ": Missing ::specs/send-bytes under"
-                    (keys outgoing)
-                    "inside"
-                    (keys state)
-                    "\na.k.a.\n"
-                    state)))
+  {:pre [array-o-bytes]}
+  (cancel-timer! state)
+  (log/info (str message-loop-name
+                 ": trigger-from-child\nSent stream address: "
+                 send-bytes))
   (trigger-io
    state-agent
    (if (from-child/room-for-child-bytes? state)
@@ -482,9 +475,19 @@
        (let [result (from-child/consume-from-child state array-o-bytes)]
          result))
      ;; trigger-io does some state management, even
-     ;; if we discard the incoming buffer
-     state)))
-
+     ;; if we discard the incoming bytes because our
+     ;; buffer is full
+     ;; TODO: Need a way to signal the child to
+     ;; try again shortly
+     (do
+       (log/error "Discarding incoming bytes, silently")
+       state))))
+
+(s/fdef trigger-from-parent
+        :args (s/cat :state-agent ::specs/state-agent
+                     :state ::specs/state
+                     :array-o-bytes bytes?)
+        :ret ::specs/state)
 (defn trigger-from-parent
   "Message block arrived from parent. We have work to do."
   ;; TODO: Move as much of this as possible into from-parent
@@ -495,11 +498,12 @@
    {{:keys [::specs/->child]} ::specs/incoming
     :keys [::specs/message-loop-name]
     :as state}
-   ^bytes buf]
-  (when-not ->child
-    (throw (ex-info "Missing ->child"
-                    {::callbacks (::specs/callbacks state)})))
+   ^bytes message]
+  {:pre [->child]}
+
+  (cancel-timer! state)
   (log/info (str message-loop-name ": Incoming from parent"))
+
   ;; This is basically an iteration of the top-level
   ;; event-loop handler from main().
   ;; I can skip the pieces that only relate to reading
@@ -509,8 +513,20 @@

   ;; However, there *is* the need to handle packets that the
   ;; child has buffered up to send to the parent.
-  (trigger-io state-agent
-              (assoc-in state [::specs/incoming ::specs/parent->buffer] buf)))
+
+  ;; Except that we can't do this here/now. That part's
+  ;; limited by the flow-control logic (handled by the
+  ;; timer) and the callbacks arriving from the child.
+  ;; It seems like we probably should cancel/reschedule,
+  ;; since whatever ACK just arrived might adjust the RTT
+  ;; logic.
+
+  (let [pre-processed (from-parent/try-processing-message! state)
+        state' (if pre-processed
+                 (to-child/forward! ->child pre-processed)
+                 state)]
+    (schedule-next-timeout! state' state-agent)
+    (trigger-io state-agent state')))

 (defn trigger-from-timer
   [state-agent


clearer execption on login failure and retry addition

--- src/com/narkisr/proxmox/remote.clj
+++ src/com/narkisr/proxmox/remote.clj
@@ -1,33 +1,38 @@
 (ns com.narkisr.proxmox.remote
   (:require
-    [taoensso.timbre :only (debug info error)]
     [cheshire.core :refer :all]
     [clj-http.client :as client]
     [clj-config.core :as conf])
-  (:use clojure.core.strint))
+  (:use clojure.core.strint
+        [taoensso.timbre :only (debug info error)])
+  (:import clojure.lang.ExceptionInfo))

 (def config (conf/read-config (<<  "~(System/getProperty \"user.home\")/.multistage.edn")))

 (def root (<< "https://~(-> config :hypervisor :host):8006/api2/json"))

 (defn retry
- "A retry for http calls against proxmox"
+  "A retry for http calls against proxmox,
+  this is useful since some operations lock machine after completion"
   [ex try-count http-context]
-
-  (println "Got:" ex)
-  (if (> try-count 4) false true))
+  (debug "re-trying due to " ex " attempt " try-count)
+  (.sleep (Thread/currentThread) 500)
+  (if (> try-count 2) false true))

 (defn root-post [api args]
-  (client/post (str root api) (assoc args :insecure? true)))
+  (client/post (str root api) (assoc args :insecure? true :retry-handler retry)))

 (defn root-delete [api args]
-  (client/delete (str root api) (assoc args :insecure? true)))
+  (client/delete (str root api) (assoc args :insecure? true :retry-handler retry)))
+
+(def login-creds (dissoc (assoc (config :hypervisor) :realm "pam") :host))

 (defn login []
-  (let [res (root-post "/access/ticket" {:form-params (dissoc (assoc (config :hypervisor) :realm "pam") :host)})]
-    (select-keys
-      (:data (parse-string (:body res) true))
-      [:CSRFPreventionToken :ticket])))
+  (try
+    (let [res (root-post "/access/ticket" {:form-params login-creds})]
+      (select-keys (:data (parse-string (:body res) true)) [:CSRFPreventionToken :ticket]))
+    (catch Exception e
+      (throw (ExceptionInfo. "Failed to login" config)))))

 (def auth-headers
   (let [{:keys [CSRFPreventionToken ticket] :as headers} (login)]
@@ -35,8 +40,8 @@
       (assoc {} "Cookie" (str "PVEAuthCookie=" ticket)) "CSRFPreventionToken" CSRFPreventionToken)))

 (defn prox-post
-  "Do a post against a proxmox instance with provided params with a retry count"
-  ([api] (prox-post api retry nil))
+  "A post against a proxmox instance with provided params"
+  ([api] (prox-post api nil))
   ([api params]
    (if (nil? params)
      (root-post api {:headers auth-headers})


cleanup

cleanup

--- utils/project.clj
+++ utils/project.clj
@@ -13,5 +13,5 @@
   :profiles {:dev {:dependencies [[midje "1.6.3"]]
                    :plugins [[lein-midje "3.1.3"]]}}

-  :deploy-repositories[["clojars" {:url "https://clojars.org/repo/"
+  :deploy-repositories [["clojars" {:url "https://clojars.org/repo/"
                                    :sign-releases false}]])


Make lenses work on cljs again.

Make lenses work on cljs again.

--- src/active/clojure/lens.cljc
+++ src/active/clojure/lens.cljc
@@ -33,16 +33,19 @@
   Lens
   (-yank [lens data] (apply yanker data args))
   (-shove [lens data v] (apply shover data v args))
-  clojure.lang.IFn
-  (invoke [this data] (-yank this data))
-  (invoke [this data v] (-shove this data v))
-  (applyTo [this args]
-    (let [args (object-array args)]
-      (case (count args)
-        1 (-yank this (aget args 0))
-        2 (-shove this (aget args 0) (aget args 1))
-        (throw #?(:clj (java.lang.IllegalArgumentException. (str "invalid number of arguments (" (count args) ") to lens")))
-               #?(:cljs (str "invalid number of arguments (" (count args) ") to lens")))))))
+  #?@(:clj [clojure.lang.IFn
+            (invoke [this data] (-yank this data))
+            (invoke [this data v] (-shove this data v))
+            (applyTo [this args]
+                     (let [args (object-array args)]
+                       (case (count args)
+                         1 (-yank this (aget args 0))
+                         2 (-shove this (aget args 0) (aget args 1))
+                         (throw #?(:clj (java.lang.IllegalArgumentException. (str "invalid number of arguments (" (count args) ") to lens")))
+                                #?(:cljs (str "invalid number of arguments (" (count args) ") to lens"))))))]
+      :cljs [IFn
+             (-invoke [this data] (-yank this data))
+             (-invoke [this data v] (-shove this data v))]))

 (defn lens
   "Returns a new lens defined by the given yanker function, which


Add support for single index runs

Add support for single index runs

--- src/aerobio/htseq/common.clj
+++ src/aerobio/htseq/common.clj
@@ -78,7 +78,7 @@
            (fn[v] (#{"tnseq", "rnaseq", "termseq" "wgseq"} (first v)))
            recs)
         recs (if (seq x) x (cons ["rnaseq" "noexp" "noexp"] recs))
-        exp-rec [(coll/takev 3 (first recs))]] ; ensure 3 fields
+        exp-rec [(coll/takev 5 (first recs))]] ; ensure 3 fields
     (loop [S (rest recs)
            I [exp-rec]]
       (if (not (seq S))
@@ -303,6 +303,10 @@
          (assoc m :run-xref
                 (->> (m :exp-sample-info) :run-xref))))
       ((fn[m]
+         (assoc m :single-index
+                (->> (m :exp-sample-info) :exp-rec
+                     first (into #{}) (#(% "single-index"))))))
+      ((fn[m]
          (assoc m :exp (get-exp-type (m :exp-sample-info))
                 :sample-names
                 (->> (m :exp-sample-info)
@@ -489,7 +493,9 @@
                  file-groups)))))

 (defn split-barcodes
-  [in-fq sqxform-fn ot-fq-map barcodes-map other-barcodes qc-ctpt sqc%]
+  [in-fq sqxform-fn ot-fq-map
+   no-barcodes? barcodes-map other-barcodes
+   qc-ctpt sqc%]

   (letio [bclen (->> ot-fq-map keys first count long)
           inf (io/open-streaming-gzip in-fq :in)
@@ -504,7 +510,8 @@
       (loop [recs (bufiles/read-fqrecs inf rec-chunk-size)]
         (if (not (seq recs))
           :done
-          (let [recs (r/fold
+          (let [no-barcodes-bcs (keys ot-fq-map)
+                recs (r/fold
                       partition
                       (fn([] [])
                         ([V v]
@@ -512,18 +519,28 @@
                                    (conj V rec))
                                  V v)))
                       (fn[V fqrec]
-                        (let [[id sq aux qc] (sqxform-fn fqrec)
-                              bc (get-sq-bc sq bclen
-                                            barcodes-map
-                                            other-barcodes)]
-                          (if bc
+                        (let [[id sq aux qc] (sqxform-fn fqrec)]
+
+                          (if no-barcodes?
+                            ;; typical in vivo no replicates branch
                             (if (pass-qcscore qc qc-ctpt sqc%)
-                              (let [len (count sq)
-                                    sq (str/substring sq bclen len)
-                                    qc (str/substring qc bclen len)]
-                                (conj V [bc [id sq aux qc]]))
+                              (reduce (fn[V bc]
+                                        (conj V [bc [id sq aux qc]]))
+                                      V no-barcodes-bcs)
                               V)
-                            V)))
+
+                            ;; This is the usual branch (in vitro replicate)
+                            (let [bc (get-sq-bc sq bclen
+                                                barcodes-map
+                                                other-barcodes)]
+                              (if bc
+                                (if (pass-qcscore qc qc-ctpt sqc%)
+                                  (let [len (count sq)
+                                        sq (str/substring sq bclen len)
+                                        qc (str/substring qc bclen len)]
+                                    (conj V [bc [id sq aux qc]]))
+                                  V)
+                                V)))))
                       recs)]
             (write-chunk-to-files ot-fd-map recs)
             (recur (bufiles/read-fqrecs inf rec-chunk-size)))))
@@ -533,10 +550,11 @@

 (defn split-filter-fastqs
-  [eid sqxform-fn & {:keys [baseqc% sqc%]
-                     :or {baseqc% 0.96 sqc% 0.97}}]
-
-  (let [base (get-exp-info eid :base)
+  [eid sqxform-fn & {:keys [baseqc% sqc% no-barcodes?]
+                     :or {baseqc% 0.96 sqc% 0.97 no-barcodes? false}}]
+
+  (let [no-barcodes? (get-exp-info eid :single-index)
+        base (get-exp-info eid :base)
         exp-illumina-xref (get-exp-info eid :exp-illumina-xref)
         illumina-sample-xref (get-exp-info eid :illumina-sample-xref)
         barcode-maps (get-exp-info eid :barcode-maps)
@@ -567,6 +585,7 @@
           (split-barcodes (sample-ifq-xref samp)
                           sqxform-fn
                           (bc-file-specs ibc)
+                          no-barcodes?
                           (barcode-maps ibc)
                           (red1codes sid)
                           qc-ctpt sqc%))))


sort (require)s

sort (require)s

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -5,11 +5,10 @@
 (require '[babel.forest :as forest])
 (require '[babel.enrich :refer [enrich]])
 (require '[babel.espanol.grammar :refer [small]])
-(require '[babel.espanol.lexicon :as lex])
+(require '[babel.espanol.lexicon :refer [lexicon]])
+(require '[babel.espanol.morphology :as morph :refer [fo morph-walk-tree]])
 (require '[babel.espanol.pos :refer :all])
 (require '[babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)])
-(require '[babel.espanol.lexicon :refer [lexicon]])
-(require '[babel.espanol.morphology :as morph :refer [fo morph-walk-tree]])
 (require '[babel.parse :as parse])
 (require '[babel.ug :refer :all])
 (require '[babel.writer :refer [process write-lexicon]])


fix docstring

fix docstring

--- src/clj/com/rpl/specter.cljc
+++ src/clj/com/rpl/specter.cljc
@@ -972,7 +972,7 @@
             :else (i/throw-illegal "NAME can only be used on symbols or keywords - " structure)
             ))))

-(defnav ^{:doc "Navigates to the name portion of the keyword or symbol"}
+(defnav ^{:doc "Navigates to the namespace portion of the keyword or symbol"}
   NAMESPACE
   []
   (select* [this structure next-fn]


remove recent bookmarks cache

remove recent bookmarks cache

--- src/clj/lesezeichen/core.clj
+++ src/clj/lesezeichen/core.clj
@@ -74,9 +74,7 @@
           :get-all-bookmarks {:topic topic :data (get-all-bookmarks conn)}
           :sign-up {:topic topic :data (add-user conn (assoc data :host (:mail-host @state) :port (:mail-port @state) :host-name (:host-name @state)))}
           :register-device {:topic topic :data (register-device conn data)}
-          :add-bookmark (do
-                          (swap! state #(update-in % [:recent-bookmarks] (fn [old new] (take 50 (conj old new))) ))
-                          {:topic topic :data (add-bookmark conn (assoc data :title (fetch-url-title (:url data))))})
+          :add-bookmark {:topic topic :data (add-bookmark conn (assoc data :title (fetch-url-title (:url data))))}
           :verify-token (handle-token state channel msg)
           {:topic :error :data :unknown-request})
         {:topic :error :data :not-authorized})))


log handler + query-params cleanup

log handler + query-params cleanup

#20

--- src/clj/swarmpit/handler.clj
+++ src/clj/swarmpit/handler.clj
@@ -1,6 +1,5 @@
 (ns swarmpit.handler
-  (:require [cemerick.url :refer [query->map]]
-            [clojure.walk :refer [keywordize-keys]]
+  (:require [clojure.walk :refer [keywordize-keys]]
             [clojure.java.io :as io]
             [swarmpit.api :as api]
             [swarmpit.token :as token]))
@@ -117,6 +116,11 @@
 (defmethod dispatch :service-tasks [_]
   (fn [{:keys [route-params]}]
     (->> (api/service-tasks (:id route-params))
+         (resp-ok))))
+
+(defmethod dispatch :service-logs [_]
+  (fn [{:keys [route-params]}]
+    (->> (api/service-logs (:id route-params))
          (resp-ok))))

 (defmethod dispatch :service-create [_]
@@ -303,9 +307,9 @@
            (resp-ok)))))

 (defmethod dispatch :registry-repository-tags [_]
-  (fn [{:keys [route-params query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-name (:repository query)
+  (fn [{:keys [route-params query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-name (:repository query-params)
           registry-id (:id route-params)]
       (if (nil? repository-name)
         (resp-error 400 "Parameter repository missing")
@@ -313,10 +317,10 @@
              (resp-ok))))))

 (defmethod dispatch :registry-repository-ports [_]
-  (fn [{:keys [route-params query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-name (:repositoryName query)
-          repository-tag (:repositoryTag query)
+  (fn [{:keys [route-params query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-name (:repositoryName query-params)
+          repository-tag (:repositoryTag query-params)
           registry-id (:id route-params)]
       (if (or (nil? repository-name)
               (nil? repository-tag))
@@ -367,9 +371,9 @@
            (resp-ok)))))

 (defmethod dispatch :dockerhub-repository-tags [_]
-  (fn [{:keys [route-params query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-name (:repository query)
+  (fn [{:keys [route-params query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-name (:repository query-params)
           dockeruser-id (:id route-params)]
       (if (nil? repository-name)
         (resp-error 400 "Parameter repository missing")
@@ -377,10 +381,10 @@
              (resp-ok))))))

 (defmethod dispatch :dockerhub-repository-ports [_]
-  (fn [{:keys [route-params query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-name (:repositoryName query)
-          repository-tag (:repositoryTag query)
+  (fn [{:keys [route-params query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-name (:repositoryName query-params)
+          repository-tag (:repositoryTag query-params)
           dockeruser-id (:id route-params)]
       (if (or (nil? repository-name)
               (nil? repository-tag))
@@ -391,27 +395,27 @@
 ;; Public dockerhub handler

 (defmethod dispatch :public-repositories [_]
-  (fn [{:keys [query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-query (:query query)
-          repository-page (:page query)]
+  (fn [{:keys [query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-query (:query query-params)
+          repository-page (:page query-params)]
       (->> (api/public-repositories repository-query repository-page)
            (resp-ok)))))

 (defmethod dispatch :public-repository-tags [_]
-  (fn [{:keys [query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-name (:repository query)]
+  (fn [{:keys [query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-name (:repository query-params)]
       (if (nil? repository-name)
         (resp-error 400 "Parameter repository missing")
         (->> (api/public-tags repository-name)
              (resp-ok))))))

 (defmethod dispatch :public-repository-ports [_]
-  (fn [{:keys [query-string]}]
-    (let [query (keywordize-keys (query->map query-string))
-          repository-name (:repositoryName query)
-          repository-tag (:repositoryTag query)]
+  (fn [{:keys [query-params]}]
+    (let [query-params (keywordize-keys query-params)
+          repository-name (:repositoryName query-params)
+          repository-tag (:repositoryTag query-params)]
       (if (or (nil? repository-name)
               (nil? repository-tag))
         (resp-error 400 "Parameter repositoryName or repositoryTag missing")


adjust default/override maps for number input fields

--- src/clj_money/web/shared.clj
+++ src/clj_money/web/shared.clj
@@ -242,10 +242,10 @@
 (defn number-input-field
   ([model attribute] (number-input-field model attribute {}))
   ([model attribute options]
-   (input-field model attribute (merge {:format-fn #(format-number % {:format :no-comma})}
+   (input-field model attribute (merge {:format-fn #(format-number % {:format :no-comma})
+                                        :step "0.01"}
                                        options
-                                       {:type :number
-                                        :step "0.01"}))))
+                                       {:type :number}))))

 (defn password-input-field
   ([model attribute] (password-input-field model attribute {}))


Change redis-atom to multi-arity function

--- src/clojure/duratom/core.clj
+++ src/clojure/duratom/core.clj
@@ -268,16 +268,23 @@
    :write (partial ut/pr-str-fully true)
    :commit-mode DEFAULT_COMMIT_MODE}) ;; technically not needed but leaving it for transparency)

-(defn redis-atom [db-config key-name lock initial-value rw]
-  (map->Duratom (merge
-                  {:lock lock
-                   :init initial-value
-                   :make-backend (partial storage/->RedisBackend
-                                          db-config
-                                          key-name
-                                          (:read rw)
-                                          (:write rw))}
-                  (select-keys rw [:commit-mode]))))
+(defn redis-atom
+  "Creates and returns a Redis-backed atom. If the location denoted by the combination of <db-config> and <key-name> exists,
+  it is read and becomes the initial value. Otherwise, the initial value is <init> and the key <key-name> is updated."
+  ([db-config key-name]
+   (redis-atom db-config key-name (ReentrantLock.) nil))
+  ([db-config key-name lock initial-value]
+   (redis-atom db-config key-name lock initial-value default-redis-rw))
+  ([db-config key-name lock initial-value rw]
+   (map->Duratom (merge
+                   {:lock lock
+                    :init initial-value
+                    :make-backend (partial storage/->RedisBackend
+                                           db-config
+                                           key-name
+                                           (:read rw)
+                                           (:write rw))}
+                   (select-keys rw [:commit-mode])))))

 (defmulti duratom
           "Top level constructor function for the <Duratom> class.


Fix bug preventing new files from being created at the project root

--- src/clojure/nightcode/ui.clj
+++ src/clojure/nightcode/ui.clj
@@ -110,7 +110,7 @@
   "Returns the root path that the selected path is contained within."
   []
   (when-let [^String path (get-selected-path)]
-    (-> #(.startsWith path (str % File/separator))
+    (-> #(or (.startsWith path (str % File/separator)) (= path %))
         (filter @tree-projects)
         first)))


robustness on morphological analysis against input variants

--- src/babel/italiano/morphology.cljc
+++ src/babel/italiano/morphology.cljc
@@ -1343,7 +1343,20 @@
                              (get lexicon potential-lexical-form)))))))))
    replace-patterns))

+(declare analyze-capitalization-variant)
+
 (defn analyze [surface-form lexicon]
+  (mapcat (fn [each-variant]
+            (analyze-capitalization-variant each-variant lexicon))
+          (set
+           (list
+            surface-form
+            (string/capitalize surface-form)
+            (string/capitalize (string/lower-case surface-form))
+            (string/upper-case surface-form)
+            (string/lower-case surface-form)))))
+
+(defn analyze-capitalization-variant [surface-form lexicon]
   "return an array of the maps, each of which represents the lexical information about a surface form."
   (concat
    (analyze-regular surface-form lexicon)


rename 'stem' to 'boot-stem'; rename 'stem2' as 'stem'

--- src/babel/italiano/morphology.cljc
+++ src/babel/italiano/morphology.cljc
@@ -206,21 +206,21 @@
                         (throw (Exception. (str "Can't regex-find on non-string: " infinitive " from word: " word)))))
         ere-type (re-find #"ere$" infinitive)
         ire-type (re-find #"ire$" infinitive)
-        stem (cond (and (get-in word [:boot-stem1])
-                        (or (= (get-in word [:agr :number])
-                               :sing)
-                            (and (= (get-in word [:agr :person])
-                                    :3rd)
-                                 (= (get-in word [:agr :number])
-                                    :plur))))
-                   (get-in word [:boot-stem1])
-                   true
-                   (string/replace infinitive #"[iae]re$" ""))
-
-        ;; stem2 is stem without regard to :boot-stem1. It is
+        boot-stem (cond (and (get-in word [:boot-stem1])
+                             (or (= (get-in word [:agr :number])
+                                    :sing)
+                                 (and (= (get-in word [:agr :person])
+                                         :3rd)
+                                      (= (get-in word [:agr :number])
+                                         :plur))))
+                        (get-in word [:boot-stem1])
+                        true
+                        (string/replace infinitive #"[iae]re$" ""))
+
+        ;; stem is stem without regard to :boot-stem1. It is
         ;; used for gerunds, e.g.: fornire -> 'io fornisco'
         ;; but 'io fornendo', not 'io forniscendo'.
-        stem2 (string/replace infinitive #"[iae]re$" "")
+        stem (string/replace infinitive #"[iae]re$" "")

         last-stem-char-is-i (re-find #"i[iae]re$" infinitive)
         last-stem-char-is-e (re-find #"e[iae]re$" infinitive)
@@ -231,8 +231,8 @@
      :are-type are-type
      :ere-type ere-type
      :ire-type ire-type
+     :boot-stem boot-stem
      :stem stem
-     :stem2 stem2
      :last-stem-char-is-i last-stem-char-is-i
      :last-stem-char-is-e last-stem-char-is-e
      :is-care-or-gare? is-care-or-gare?
@@ -904,18 +904,21 @@
         :else
         (str infinitive )))

+     ;; <irregular gerund inflection>
      (and
       (= (get-in word [:infl]) :participle)
       (string? (get-in word [:italiano]))
       (string? (get-in word [:gerund])))
      (get-in word [:gerund])
-
+     ;; </irregular gerund inflection>
+
+     ;; <default gerund inflection>
      (and
       (= (get-in word [:infl]) :participle)
       (string? (get-in word [:italiano])))
      (let [stem-analysis (stem-analysis word)
            infinitive (:infinitive stem-analysis)
-           stem (:stem2 stem-analysis)]
+           stem (:stem stem-analysis)]
         (log/debug (str "conjugating present participle; analysis:" stem-analysis))
         (cond (= "are" (:are-type stem-analysis))
               (str stem "ando")
@@ -927,6 +930,7 @@
               (do
                 (log/warn (str "no specific conjugation found for word with stem-analysis:" stem-analysis " - returning infinitive"))
                 infinitive)))
+     ;; </default gerund inflection>

      (and
       (string? (get-in word '(:italiano)))


only style tag in conversation when an actual tag

--- src/chat/client/views/helpers.cljs
+++ src/chat/client/views/helpers.cljs
@@ -24,15 +24,19 @@
    :users
    {:pattern #"@(\S*)"
     :replace (fn [match]
-               (dom/span #js {:className "user-mention"
-                              :style #js {:backgroundColor (tag->color (store/nickname->user match))}}
-                 "@" match))}
+               (if-let [user (store/nickname->user match)]
+                 (dom/span #js {:className "user-mention"
+                                :style #js {:backgroundColor (tag->color user)}}
+                   "@" match)
+                 (dom/span nil "@" match)))}
    :tags
    {:pattern #"#(\S*)"
     :replace (fn [match]
-               (dom/span #js {:className "tag-mention"
-                              :style #js {:backgroundColor (tag->color (store/name->tag match))}}
-                 "#" match))}
+               (if-let [tag (store/name->tag match)]
+                 (dom/span #js {:className "tag-mention"
+                                :style #js {:backgroundColor (tag->color tag)}}
+                   "#" match)
+                 (dom/span nil "#" match)))}
    :emoji-shortcodes
    {:pattern #"(:\S*:)"
     :replace (fn [match]


remote auto-icebreaker from BlacKat, enable both kinds of pumps

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -77,9 +77,10 @@
                                   :effect (effect (pump card 1 :all-run)) :pump 1}]})

    "BlacKat"
-   (auto-icebreaker ["Barrier"]
-                    {:abilities [{:cost [:credit 1] :msg "break 1 barrier subroutine"}
-                                 {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]})
+   {:abilities [{:cost [:credit 1] :msg "break 1 barrier subroutine"}
+                {:cost [:credit 1] :msg "break up to 3 barrier subroutines (using a stealth [Credits])"}
+                {:cost [:credit 2] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}
+                {:cost [:credit 2] :msg "add 2 strength (using at least 1 stealth [Credits])" :effect (effect (pump card 2)) :pump 2}]}

    "Breach"
    (auto-icebreaker ["Barrier"]


Don't reset ns based on failed completion calls

--- src/clj/reply/eval_modes/nrepl.clj
+++ src/clj/reply/eval_modes/nrepl.clj
@@ -38,7 +38,8 @@
         (when out ((:out options print) out))
         (when err ((:err options print) err))
         (flush)
-        (when ns (reset! current-ns ns)))))
+        (when (and ns (not (:session options)))
+          (reset! current-ns ns)))))
     (reset! current-command-id nil)
     @current-ns))