Added class and attr args to popover-anchor-wrapper, popover-content-wrapper and popover-tooltip

--- src/re_com/popover.cljs
+++ src/re_com/popover.cljs
@@ -147,7 +147,7 @@
    {:name :on-click :required false              :type "-> nil"          :validate-fn fn?               :description "a function which takes no params and returns nothing. Called when the backdrop is clicked"}])

 (defn- backdrop
-  "Renders a backdrop dive which fills the entire page and responds to clicks on it. Can also specify how tranparent it should be"
+  "Renders a backdrop div which fills the entire page and responds to clicks on it. Can also specify how tranparent it should be"
   [& {:keys [opacity on-click] :as args}]
   {:pre [(validate-args-macro backdrop-args-desc args "backdrop")]}
   [:div.rc-backdrop.noselect
@@ -340,7 +340,9 @@
    {:name :arrow-width       :required false  :default 22           :type "integer | string" :validate-fn number-or-string? :description "the width in pixels of arrow base"}
    {:name :arrow-gap         :required false  :default -1           :type "integer"          :validate-fn number?           :description "px gap between the anchor and the arrow tip. Positive numbers push the popover away from the anchor"}
    {:name :padding           :required false                        :type "string"           :validate-fn string?           :description "a CSS style which overrides the inner padding of the popover"}
-   {:name :style             :required false                        :type "CSS style map"    :validate-fn css-style?        :description "override component style(s) with a style map, only use in case of emergency"}])
+   {:name :class             :required false                        :type "string"           :validate-fn string?           :description "CSS class names, space separated"}
+   {:name :style             :required false                        :type "CSS style map"    :validate-fn css-style?        :description "override component style(s) with a style map, only use in case of emergency"}
+   {:name :attr              :required false                        :type "HTML attr map"    :validate-fn html-attr?        :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed"]}])

 (defn popover-content-wrapper
   "Abstracts several components to handle the 90% of cases for general popovers and dialog boxes"
@@ -369,18 +371,21 @@

        :reagent-render
        (fn
-         [& {:keys [showing-injected? position-injected position-offset no-clip? width height backdrop-opacity on-cancel title close-button? body tooltip-style? popover-color arrow-length arrow-width arrow-gap padding style]
+         [& {:keys [showing-injected? position-injected position-offset no-clip? width height backdrop-opacity on-cancel title
+                    close-button? body tooltip-style? popover-color arrow-length arrow-width arrow-gap padding class style attr]
              :or {arrow-length 11 arrow-width 22 arrow-gap -1}
              :as args}]
          {:pre [(validate-args-macro popover-content-wrapper-args-desc args "popover-content-wrapper")]}

          @position-injected ;; Dereference this atom. Although nothing here needs its value explicitly, the calculation of left-offset and top-offset are affected by it for :no-clip? true
-         [:div.popover-content-wrapper
-          {:style (merge (flex-child-style "inherit")
-                         (when no-clip? {:position "fixed"
-                                         :left      (px @left-offset)
-                                         :top       (px @top-offset)})
-                         style)}
+         [:div
+          (merge {:class (str "popover-content-wrapper " class)
+                  :style (merge (flex-child-style "inherit")
+                                (when no-clip? {:position "fixed"
+                                                :left      (px @left-offset)
+                                                :top       (px @top-offset)})
+                                style)}
+                 attr)
           (when (and @showing-injected? on-cancel)
             [backdrop
              :opacity  backdrop-opacity
@@ -413,7 +418,9 @@
    {:name :position :required true                        :type "keyword"         :validate-fn position?         :description [:span "relative to this anchor. One of " position-options-list]}
    {:name :anchor   :required true                        :type "string | hiccup" :validate-fn string-or-hiccup? :description "the component the popover is attached to"}
    {:name :popover  :required true                        :type "string | hiccup" :validate-fn string-or-hiccup? :description "the popover body component"}
-   {:name :style    :required false                       :type "CSS style map"   :validate-fn css-style?        :description "override component style(s) with a style map, only use in case of emergency"}])
+   {:name :class    :required false                       :type "string"          :validate-fn string?           :description "CSS class names, space separated"}
+   {:name :style    :required false                       :type "CSS style map"   :validate-fn css-style?        :description "override component style(s) with a style map, only use in case of emergency"}
+   {:name :attr     :required false                       :type "HTML attr map"   :validate-fn html-attr?        :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed"]}])

 (defn popover-anchor-wrapper
   "Renders an element or control along with a Bootstrap popover"
@@ -427,7 +434,7 @@

        :reagent-render
        (fn
-         [& {:keys [showing? position anchor popover style] :as args}]
+         [& {:keys [showing? position anchor popover class style attr] :as args}]
          {:pre [(validate-args-macro popover-anchor-wrapper-args-desc args "popover-anchor-wrapper")]}

          @reset-on-hide ;; Dereference this reaction, otherwise it won't be set up. The reaction is set to run whenever the popover closes
@@ -438,9 +445,10 @@
                place-anchor-before?    (case orientation (:left :above) false true)
                flex-flow               (case orientation (:left :right) "row" "column")]
            [:div
-            {:class  "rc-popover-anchor-wrapper display-inline-flex"
-             :style (merge (flex-child-style "inherit")
-                           style)}
+            (merge {:class (str "rc-popover-anchor-wrapper display-inline-flex " class)
+                    :style (merge (flex-child-style "inherit")
+                                  style)}
+                   attr)
             [:div                                ;; Wrapper around the anchor and the "point"
              {:class "rc-point-wrapper display-inline-flex"
               :style (merge (flex-child-style "auto")
@@ -471,11 +479,13 @@
    {:name :position      :required false :default :below-center :type "keyword"                :validate-fn position?            :description [:span "relative to this anchor. One of " position-options-list]}
    {:name :no-clip?      :required false :default true          :type "boolean"                                                  :description "when an anchor is in a scrolling region (e.g. scroller component), the popover can sometimes be clipped. When this parameter is true (which is the default), re-com will use a different CSS method to show the popover. This method is slightly inferior because the popover can't track the anchor if it is repositioned"}
    {:name :width         :required false                        :type "string"                 :validate-fn string?              :description "specifies width of the tooltip"}
-   {:name :style         :required false                        :type "CSS style map"          :validate-fn css-style?           :description "override component style(s) with a style map, only use in case of emergency"}])
+   {:name :class         :required false                        :type "string"                 :validate-fn string?              :description "CSS class names, space separated (applies to popover-anchor-wrapper component)"}
+   {:name :style         :required false                        :type "CSS style map"          :validate-fn css-style?           :description "override component style(s) with a style map, only use in case of emergency (applies to popover-anchor-wrapper component)"}
+   {:name :attr          :required false                        :type "HTML attr map"          :validate-fn html-attr?           :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed (applies to popover-anchor-wrapper component)"]}])

 (defn popover-tooltip
   "Renders text as a tooltip in Bootstrap popover style"
-  [& {:keys [label showing? on-cancel close-button? status anchor position no-clip? width style]
+  [& {:keys [label showing? on-cancel close-button? status anchor position no-clip? width class style attr]
       :or {no-clip? true}
       :as args}]
   {:pre [(validate-args-macro popover-tooltip-args-desc args "popover-tooltip")]}
@@ -490,7 +500,9 @@
      :showing? showing?
      :position (or position :below-center)
      :anchor   anchor
+     :class    class
      :style    style
+     :attr     attr
      :popover [popover-content-wrapper
                :no-clip?       no-clip?
                :on-cancel      on-cancel


cleanup

cleanup

--- src/repair/it/tutti.clj
+++ src/repair/it/tutti.clj
@@ -1,39 +0,0 @@
-;; Command line usage: 'lein run -m repair.it.tout/fix'
-(ns repair.it.tutti)
-(require '[babel.writer :refer [write-lexicon]])
-(require '[babel.english :as en])
-(require '[babel.italiano :as it :refer [parse verbs]])
-(require '[babel.italiano.morphology :as morph :refer [fo]])
-(require '[babel.parse :as parse])
-(require '[babel.reader :as reader])
-(require '[babel.repair :refer [process]])
-;; (morph/fo (deserialize (read-string (:structure (reader/id2expression 45020)))))
-;; these requires are for debugging/testing.
-(require '[clojure.data.json :as json])
-(require '[dag-unify.core :refer [unify deserialize]])
-
-(defn fix [ & [count]]
-  (let [count (if count count 10)]
-    (write-lexicon "it" @it/lexicon)
-    (process
-     (reduce concat
-             (map (fn [verb]
-                    (map (fn [tense]
-                           {:fill
-                            {:spec (unify {:root {:italiano {:italiano verb}}}
-                                          tense)
-                             :source-model en/small
-                             :target-model it/small
-                             :count count}})
-                         (shuffle
-                          [
-                           {:synsem {:sem {:tense :conditional}}}
-                           {:synsem {:sem {:tense :futuro}}}
-                           {:synsem {:sem {:infl :past}}}
-                           {:synsem {:sem {:tense :present}}}
-                         ])
-                         ))
-                  (sort verbs)
-                  )))))
-
-


refactor ->sessions-request using comp

refactor ->sessions-request using comp

--- src/shale/resources.clj
+++ src/shale/resources.clj
@@ -81,13 +81,15 @@
     (jsonify {:error message})))

 (defn ->sessions-request [context]
-  (rename-keys
-    (clojure-keys
-      (merge (get context ::data)
-        (name-keys
-          (truth-from-str-vals
-            (get-in context [:request :params])))))
-    {:reserve :reserve-after-create}))
+  (let [params (get-in context [:request :params])
+        data (get context ::data)]
+    ((comp
+       #(rename-keys % {:reserve :reserve-after-create})
+       clojure-keys
+       #(merge data %)
+       name-keys
+       truth-from-str-vals
+       ) params)))

 (defresource sessions-resource [params]
   :allowed-methods  [:get :post]


Added stubs for IPIP.

Added stubs for IPIP.

--- src/simulacrum/ipip.clj
+++ src/simulacrum/ipip.clj
@@ -1,5 +1,6 @@
 (ns simulacrum.ipip
-  (:require [simulacrum.bigfive :refer [domains questions-base]]))
+  (:require [simulacrum.bigfive :refer [domains questions-base]]
+            [simulacrum.const :as const]))

 (def facets
@@ -34,6 +35,49 @@
    :N5 "Immoderation"
    :N6 "Vulnerability"})

+(def five-point-compatibility-matrix-model-1
+  "The problems observed with this model were:
+    * "
+  (matrix/matrix
+    [[5 3 4 4 2]
+     [3 5 2 4 3]
+     [4 2 5 3 2]
+     [3 4 4 5 3]
+     [3 2 1 3 5]]))
+
+(def five-point-compatibility-matrix-model-2
+  "This model exhibits the following properties:
+    * "
+  (matrix/matrix
+    [[5 3 4 4 2]
+     [2 5 3 4 1]
+     [4 2 5 3 2]
+     [3 4 4 5 3]
+     [3 2 1 3 5]]))
+
+(def five-point-compatibility-matrix
+  "The columns of the compatibilty matrices follow the order of the OCEAN
+  acronym:
+    1) Openness, 2) Conscientiousness, 3) Extraversion, 4) Agreeableness,
+    5) Neuroticism.
+  Similarly, the rows number in the same order.
+
+  This function simply points to the matrix that provides the best default
+  model for compatibilty.
+  For more informtaion, see docs/compat.rst."
+  five-point-compatibility-matrix-model-2)
+
+(def signed-compatibility-matrix
+  "Convert the compatibilty matrix to one whose values range from -2 to 2, with
+  the neurtal value being 0."
+  (sub five-point-compatibility-matrix const/mid-value))
+
+(def normalized-compatibility-matrix
+  "Convert the compatibilty matrix to one whose values have been normalized."
+  (matrix/emap
+    float
+    (div five-point-compatibility-matrix const/max-value)))
+
 (def questions-short
   (conj
     questions-base
@@ -42,3 +86,9 @@
       [

        ]}))
+
+(def questions-long
+  )
+
+
+


Added missing } to complete sparql string

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/post-identifier-merge/step_b-ontology_to_ice/step_a/copy_owl_alldisjointclasses_to_bio.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/post-identifier-merge/step_b-ontology_to_ice/step_a/copy_owl_alldisjointclasses_to_bio.clj
@@ -9,5 +9,6 @@
           [?/bio_adc {:ln (:sha-1 ?/adc)
                   :ns "ccp" :prefix "ADC_"}])
   :sparql-string "select ?adc {
-                    ?adc rdf:type owl:AllDisjointClasses ."
+                    ?adc rdf:type owl:AllDisjointClasses .
+                   }"
   }


align comments nicely :smiling_imp:

align comments nicely :smiling_imp:

--- src/metabase/driver/generic_sql/query_processor.clj
+++ src/metabase/driver/generic_sql/query_processor.clj
@@ -182,7 +182,7 @@
                             (integer? field-id)          (field-id->kw field-id)
                             (= field-id "$$aggregation") (let [[ag] (:aggregation (:query qp/*query*))]
                                                            `(raw ~(case ag
-                                                                    "avg"      "\"avg\"" ; based on the type of the aggregation
+                                                                    "avg"      "\"avg\""   ; based on the type of the aggregation
                                                                     "count"    "\"count\"" ; make sure we ask the DB to order by the
                                                                     "distinct" "\"count\"" ; name of the aggregate field
                                                                     "stddev"   "\"stddev\""


fix arg in wrong pos

fix arg in wrong pos

--- src/metabase/driver/generic_sql/query_processor.clj
+++ src/metabase/driver/generic_sql/query_processor.clj
@@ -50,9 +50,9 @@
          (map? (:query query))
          (= (name (:type query)) "query")]}
   (try
-    (->> (process query)
-         eval
-         (qp/annotate query uncastify))
+    (as-> (process query) results
+      (eval results)
+      (qp/annotate query results uncastify))
     (catch java.sql.SQLException e
       (let [^String message (or (->> (.getMessage e)                            ; error message comes back like "Error message ... [status-code]" sometimes
                                           (re-find  #"(?s)(^.*)\s+\[[\d-]+\]$") ; status code isn't useful and makes unit tests hard to write so strip it off


Don't log braid client ping events

Don't log braid client ping events

--- src/braid/core/server/sync_handler.clj
+++ src/braid/core/server/sync_handler.clj
@@ -30,7 +30,8 @@

 (defn event-msg-handler* [{:as ev-msg :keys [id ?data event]}]
   (when-not (= event [:chsk/ws-ping])
-    (debugf "User: %s Event: %s" (get-in ev-msg [:ring-req :session :user-id]) event)
+    (when (not= event :braid.client/ping)
+      (debugf "User: %s Event: %s" (get-in ev-msg [:ring-req :session :user-id]) event))

     (when-let [user-id (get-in ev-msg [:ring-req :session :user-id])]
       (if-let [dynamic-msg-handler (get @message-handlers id)]


Changes from monday

Changes from monday

--- src/clj/org/openforis/ceo/db/plots.clj
+++ src/clj/org/openforis/ceo/db/plots.clj
@@ -21,41 +21,38 @@
                             :analyses assigned})
                          (call-sql "select_limited_project_plots" project-id max-plots)))))

-(defn- prepare-samples-object [plot-id project-id]
+(defn- prepare-samples-array [plot-id project-id]
   (mapv (fn [{:keys [sample_id point sampleId geom value]}]
-          {:id       sample_id
-           :point    point
-           :sampleId sampleId ;TODO I don't think we we distinguish between sample_id and sampleId so this could go away
-           :geom     (tc/jsonb->clj geom)
-           :value    (if (< 2 (count (str value)))
-                       (tc/jsonb->clj value)
-                       {})})
+          (merge {:id       sample_id
+                  :point    point
+                  :sampleId sampleId ;TODO I don't think we distinguish between sample_id and sampleId so this could go away
+                  :geom     (tc/jsonb->clj geom)}
+                 (when (< 2 (count (str value)))
+                   {:value (tc/jsonb->clj value)})))
         (call-sql "select_plot_samples" plot-id project-id)))

-(defn- clean-extra-plot-info [extra-plot-info]
-  (or (dissoc (tc/jsonb->clj extra-plot-info) :gid :lat :lon :plotid)
-      {}))
-
 (defn- prepare-plot-object [plot-info project-id]
-  (let [{:keys [plot_id center flagged plotId geom extra_plot_info]} plot-info]
+  (let [{:keys [plot_id center flagged assigned plotId geom extra_plot_info]} plot-info]
     {:id            plot_id
      :projectId     project-id ;TODO why do we need to return a value that is already known
      :center        center
      :flagged       (< 0 (or flagged -1))
+     :analyses      assigned
      :plotId        plotId
      :geom          (tc/jsonb->clj geom)
-     :extraPlotInfo (clean-extra-plot-info extra_plot_info)
-     :samples       (prepare-samples-object plot_id project-id)}))
+     :extraPlotInfo (dissoc (tc/jsonb->clj extra_plot_info) :gid :lat :lon :plotid)
+     :samples       (prepare-samples-array plot_id project-id)}))

 (defn get-project-plot [{:keys [params]}]
   (let [project-id (tc/str->int (:projectId params))
         plot-id    (tc/str->int (:plotId params))]
-    (data-response (prepare-plot-object (first (call-sql "select_plot_by_id"
-                                                         project-id
-                                                         plot-id))
-                                        project-id))))
+    (data-response (if-let [plot-info (first (call-sql "select_plot_by_id"
+                                                       project-id
+                                                       plot-id))]
+                     (prepare-plot-object plot-info project-id)
+                     ""))))

-(defn- unlock_plots [user-id]
+(defn- unlock-plots [user-id]
   (call-sql-opts "unlock_plots" {:log? false} user-id))

 (defn reset-plot-lock [{:keys [params]}]
@@ -65,7 +62,7 @@
     (data-response "")))

 (defn release-plot-locks [{:keys [params]}]
-  (unlock_plots (:userId params -1))
+  (unlock-plots (:userId params -1))
   (data-response ""))

 (defn- get-collection-plot [params method]
@@ -88,7 +85,7 @@
                                                :else
                                                (sql2 (str "select_" method "unassigned_plot"))))]
                      (do
-                       (unlock_plots user-id)
+                       (unlock-plots user-id)
                        (call-sql "lock_plot"
                                  (:plot_id plot-info)
                                  user-id
@@ -129,12 +126,12 @@
                     (Timestamp. collection-start)
                     user-samples
                     user-images]))
-    (unlock_plots user-id)
+    (unlock-plots user-id)
     (data-response "")))

 (defn flag-plot [{:keys [params]}]
   (let [plot-id (tc/str->int (:plotId params))
         user-id (:userId params -1)]
     (call-sql "flag_plot" plot-id user-id nil)
-    (unlock_plots user-id)
+    (unlock-plots user-id)
     (data-response "")))


refine create account

refine create account

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -122,13 +122,20 @@
                            :list-fn (fn [_]
                                       (map (juxt :symbol :id) @*commodities*))}]]])

+(defn- find-account
+  [id]
+  (->> @*accounts*
+       (filter #(= id (:id %)))
+       first))
+
 (defn- create-account
-  [account]
-  (accounts/create (if (:parent-id account)
-                     (dissoc account :type)
-                     account)
-                   #(secretary/dispatch! "/accounts")
-                   notify/danger))
+  [{:keys [parent-id] :as account}]
+  (let [parent (find-account parent-id)]
+    (accounts/create (if parent
+                       (assoc account :type (:type parent))
+                       account)
+                     #(secretary/dispatch! "/accounts")
+                     notify/danger)))

 (defn- new-account []
   (accounts/get-all (:id @state/current-entity)


deep-trace2 integrated with trace

deep-trace2 integrated with trace

--- src/com/billpiel/sayid/deep_trace2.clj
+++ src/com/billpiel/sayid/deep_trace2.clj
@@ -13,7 +13,7 @@
           xx (clojure.walk/macroexpand-all form)] ;; TODO better way?
       (conj (mapcat form->xform-map* x)
             {form xx}))
-    [[form form]]))
+    [{form form}]))

 (defn form->xform-map
   [form]
@@ -53,11 +53,14 @@

 (defn sym-seq->parent
   [syms]
-  (-> syms
-      first
-      sym->path
-      drop-last
-      path->sym))
+  (util/$- -> syms
+           first
+           (if (coll? $)
+             (sym-seq->parent $)
+             $)
+           sym->path
+           drop-last
+           path->sym))

 (defn swap-in-path-syms*
   [form func parent path skip-macro?]
@@ -131,7 +134,8 @@
 ;;  xl->xp (deep-zipmap (-> src clojure.walk/macroexpand-all swap-in-path-syms) (clojure.walk/macroexpand-all src))
 ;;  olop->op (deep-zipmap (swap-in-path-syms src) src)

-(defn mk-expr-mapping
+(defn mk-expr
+  -mapping
   [form]
   (let [xls (->> form
                  clojure.walk/macroexpand-all
@@ -202,7 +206,7 @@
                            :path' path
                            :parent-name (:name fn-meta)
                            :ns (-> fn-meta :ns str symbol)
-                           :args (vec args)          ;;TODO
+                           :args (vec args)
                            :arg-map  (delay (zipmap (-> src-map
                                                         :xp
                                                         rest)
@@ -252,7 +256,7 @@
 (defn xpand-fn
   [head form path]
   (cons
-   (list 'capture-fn path '$$ head)
+   (list `capture-fn path '$$ head)
    (rest form)))

 (defn xpand-macro
@@ -299,7 +303,6 @@
                             path')))
     form))

-;; TODO should take coll of forms?
 (defn xpand
   [form parent-fn-meta]
   (let [expr-map (mk-expr-mapping form)]
@@ -308,8 +311,19 @@
        (record-trace-tree ~'$$)
        ~'$return)))

-
-(def trace (atom nil))
+(defn xpand-bod
+  [fn-bod parent-fn-meta]
+  (cons (first fn-bod)
+        (map #(xpand % parent-fn-meta)
+             (rest fn-bod))))
+
+(defn xpand-fn*
+  [form parent-fn-meta]
+  (let [bods (->> form
+                  rest
+                  (map #(xpand-bod % parent-fn-meta)))]
+    (cons (first form)
+          bods)))

 (defn log->tree1
   [log src-map fn-meta]
@@ -372,58 +386,48 @@
              (tree1->trace-tree trace/*trace-log-parent*
                                 src-map))))

+(defn get-fn
+  [[d s f & r]]
+  (if (and (= d 'def)
+           (symbol? s)
+           (-> f nil? not)
+           (nil? r))
+    f
+    (throw (Exception. (format "Expected a defn form, but got this (%s %s ..."
+                               d s)))))
+
 ;;TODO trace multi-arity works??
 (defn deep-tracer
-  [{:keys [workspace qual-sym meta' ns']} original-fn] ;; original-fn and workspace not used! IS THAT RIGHT??
+  [{:keys [workspace qual-sym meta' ns']}] ;; original-fn and workspace not used! IS THAT RIGHT??
   (let [src (-> qual-sym
                 symbol
                 util/hunt-down-source)
         xsrc (clojure.walk/macroexpand-all src)
-        get-fn (fn [[d s f & r]] (if (and (= d 'def)
-                                          (symbol? s)
-                                          (-> f nil? not)
-                                          (nil? r))
-                                   (throw (Exception. (format "Expected a defn form, but got this (%s %s ..."
-                                                              d s)))))
-        traced-form  (get-fn (xpand src meta'))]
+        traced-form (-> src
+                        macroexpand
+                        get-fn
+                        (xpand-fn* meta'))]
     (util/eval-in-ns (-> ns' str symbol)
                      traced-form)))

- #_ (-> #spy/d (xpand '(let [a 1
-                         b 2]
-                     (if false
-                       a
-                       b)))
-           eval)
-
-#_ (binding [trace/*trace-log-parent* (trace/mk-tree :id-prefix "root" :parent {})]
-     (def tree trace/*trace-log-parent*)
-     (-> (xpand '(let [a 1]
-                   (-> a
-                       inc
-                       dec
-                       nil?))
-                {:name "ofunc" :ns "ns1"})
-         eval))
-
-#_ (binding [trace/*trace-log-parent* (trace/mk-tree :id-prefix "root" :parent {})]
-     (def tree trace/*trace-log-parent*)
-     (-> #spy/d (xpand
-                 '(if (= 1 2) 3 4))
-         eval))
-
-
-#_  (-> (xpand )
-           eval)
-
-
-#_ (do
-
-     #spy/d (-> (xpand '(let [a 1
-                         b 2]
-                     (if false
-                       a
-                       b)))
-           eval)
-
-     (comment))
+
+(defn ^{::trace/trace-type :deep-fn} composed-tracer-fn
+  [m _]
+  (->> m
+       deep-tracer
+       (trace/shallow-tracer m)))
+
+(defmethod trace/trace* :deep-fn
+  [_ fn-sym workspace]
+  (-> fn-sym
+      resolve
+      (trace/trace-var* (util/assoc-var-meta-to-fn composed-tracer-fn
+                                                   ::trace/trace-type)
+                        workspace)))
+
+
+(defmethod trace/untrace* :deep-fn
+  [_ fn-sym]
+  (-> fn-sym
+      resolve
+      trace/untrace-var*))


kibit and cljfmt require different clojure versions

Exclude one.

--- leiningen/.lein/profiles.clj
+++ leiningen/.lein/profiles.clj
@@ -1,3 +1,3 @@
 {:user {:plugins [[lein-ancient "0.6.10"]
                   [lein-cljfmt "0.5.6"]
-                  [lein-kibit "0.1.3"]]}}
+                  [lein-kibit "0.1.5" :exclusions [org.clojure/clojure]]]}}


Clarify it's a puzzle

Clarify it's a puzzle

--- src/tile_game/grid.cljs
+++ src/tile_game/grid.cljs
@@ -42,7 +42,7 @@
   (let [{:keys [board size]} @app-state
         dim (b/dimension board)]
     [:center
-     [:h1 "Tile Grid"]
+     [:h1 "Tile Puzzle"]
      [:svg {:view-box (str "0 0 " dim " " dim) :width 800 :height 800}
       (for [x (range dim) y (range dim)]
         (let [tile (nth board (+ (* y dim) x))]


update batch size for gene and variation because the jobs are slower

--- src/wb_es/bulk/core.clj
+++ src/wb_es/bulk/core.clj
@@ -185,7 +185,7 @@
             (doseq [job jobs]
               (>!! scheduler job)))
           (let [eids (get-eids-by-type db :gene/id)
-                jobs (make-batches 1000 :gene eids)]
+                jobs (make-batches 100 :gene eids)]  ; smaller batch for slower ones
             (doseq [job jobs]
               (>!! scheduler job)))
           (let [eids (get-eids-by-type db :gene-class/id)
@@ -305,7 +305,7 @@
             (doseq [job jobs]
               (>!! scheduler job)))
           (let [eids (get-eids-by-type db :variation/id)
-                jobs (make-batches 1000 :variation eids)]
+                jobs (make-batches 100 :variation eids)] ; smaller batch for slower ones
             (doseq [job jobs]
               (>!! scheduler job)))


extract function

extract function

--- src/zombie_run/game.clj
+++ src/zombie_run/game.clj
@@ -76,20 +76,24 @@
                 ::weapon/weapon     (weapon/make-weapon :dagger)
                 ::terrain/direction (action->coords direction)}))))

+(defn- find-target-in-range [terrain world-size player-pos range]
+  (let [player-direction (terrain/get-property terrain player-pos ::terrain/direction)]
+    (reduce (fn [_ counter]
+              (let [target-pos (world/step-into-direction world-size
+                                                          player-pos
+                                                          player-direction
+                                                          counter)]
+                (when (terrain/has-type? terrain target-pos :zombie)
+                  (reduced target-pos))))
+            nil
+            (range 1 (inc range)))))
+
 (defn- player-attack [{terrain ::terrain/terrain-map world-size ::world-size :as game} player-pos]
-  (let [player-direction (terrain/get-property terrain player-pos ::terrain/direction)
-        player-weapon (terrain/get-property terrain player-pos ::weapon/weapon)
-        find-target (fn [_ counter]
-                      (let [target-pos (world/step-into-direction world-size
-                                                                  player-pos
-                                                                  player-direction
-                                                                  counter)]
-                        (when (terrain/has-type? terrain target-pos :zombie)
-                          (reduced target-pos))))
-        weapon range]
-    (if-let [target-pos (reduce find-target
-                                nil
-                                (range 1 (inc (weapon/weapon-range player-weapon))))]
+  (let [player-weapon (terrain/get-property terrain player-pos ::weapon/weapon)]
+    (if-let [target-pos (find-target-in-range terrain
+                                              world-size
+                                              player-pos
+                                              (weapon/weapon-range player-weapon))]
       (let [[weapon damage] (weapon/fire player-weapon)]
         (assoc game ::terrain/terrain-map (-> terrain
                                               (terrain/set-property player-pos ::weapon/weapon weapon)


Use pprint for generate db.edn

Use pprint for generate db.edn

--- tutorial.vent/src/tutorial/vent/db.clj
+++ tutorial.vent/src/tutorial/vent/db.clj
@@ -3,6 +3,7 @@
   (:require
     [clojure.edn :as edn]
     [clojure.java.io :as io]
+    [clojure.pprint :as pp]
     [tutorial.vent.reload :as vent.reload])
   (:refer-clojure :exclude [read]))

@@ -13,8 +14,11 @@
   [x]
   (binding [*print-length* nil
             *print-level* nil
-            *print-namespace-maps* false]
-    (let [edn-str (prn-str x)]
+            *print-namespace-maps* false
+            pp/*print-right-margin* 100
+            pp/*print-miser-width* 80]
+    (let [edn-str (with-out-str
+                    (pp/pprint x))]
       ;; Confirm that the edn reads back, i.e. there are no #object or similar
       ;; that can't be read
       (try


Improve performance of params middleware

--- ring-core/src/ring/middleware/params.clj
+++ ring-core/src/ring/middleware/params.clj
@@ -8,25 +8,33 @@
   (let [params (codec/form-decode params encoding)]
     (if (map? params) params {})))

+(defn- assoc-param-map [req k v]
+  (some-> req (assoc k (if-let [v' (req k)]
+                         (reduce-kv assoc v' v)
+                         v))))
+
 (defn assoc-query-params
   "Parse and assoc parameters from the query string with the request."
   {:added "1.3"}
   [request encoding]
-  (merge-with merge request
-    (if-let [query-string (:query-string request)]
-      (let [params (parse-params query-string encoding)]
-        {:query-params params, :params params})
-      {:query-params {}, :params {}})))
+  (let [params (if-let [query-string (:query-string request)]
+                 (parse-params query-string encoding)
+                 {})]
+    (-> request
+        (assoc-param-map :query-params params)
+        (assoc-param-map :params params))))

 (defn assoc-form-params
   "Parse and assoc parameters from the request body with the request."
   {:added "1.2"}
   [request encoding]
-  (merge-with merge request
-    (if-let [body (and (req/urlencoded-form? request) (:body request))]
-      (let [params (parse-params (slurp body :encoding encoding) encoding)]
-        {:form-params params, :params params})
-      {:form-params {}, :params {}})))
+  (let [params (if-let [body (and (req/urlencoded-form? request)
+                                  (:body request))]
+                 (parse-params (slurp body :encoding encoding) encoding)
+                 {})]
+    (-> request
+        (assoc-param-map :form-params params)
+        (assoc-param-map :params params))))

 (defn params-request
   "Adds parameters from the query string and the request body to the request


Upgrade todomvc example shadow-cljs to 2.8.59

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -3,7 +3,7 @@
                  [org.clojure/clojurescript  "1.10.520"
                   :exclusions [com.google.javascript/closure-compiler-unshaded
                                org.clojure/google-closure-library]]
-                 [thheller/shadow-cljs "2.8.52"]
+                 [thheller/shadow-cljs "2.8.59"]
                  [reagent "0.9.0-rc1"]
                  [re-frame "0.11.0-rc2-SNAPSHOT"]
                  [binaryage/devtools "0.9.10"]


+(deftest generate-and-parse-noun-phrase-with-specifier)

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -84,6 +84,14 @@

 (deftest forbid-mispelling
  (is (empty? (:parses (parse (fo "la donna difficila") np-grammar)))))
+
+(deftest generate-and-parse-noun-phrase-with-specifier
+  ;; create a noun phrase where the determiner is "ventotto", but the head of the noun phrase
+  ;; might be anything.
+  (let [result (generate {:synsem {:sem {:spec {:def :twentyeight}}}} np-grammar)]
+    (is (not (= "" (fo result))))
+    (is (= :twentyeight (get-in result [:synsem :sem :spec :def])))
+    (is (not (empty? (parse (fo result)))))))

 (def map-fn #?(:clj pmap) #?(:cljs map))


Clean up project file

Clean up project file

--- resources/leiningen/new/bocko_ios/project.clj
+++ resources/leiningen/new/bocko_ios/project.clj
@@ -1,11 +1,10 @@
-(defproject bocko-ios "0.2.0"
+(defproject bocko-ios "0.1.0"
   :description "Use Bocko on iOS"
-  :dependencies [[org.clojure/clojure "1.7.0-beta3"]
+  :dependencies [[org.clojure/clojure "1.7.0-RC1"]
                  [org.clojure/clojurescript "0.0-3269"]
-                 [org.clojure/core.async "0.1.346.0-17112a-alpha"]
                  [bocko "0.3.0"]
                  [org.omcljs/ambly "0.3.0"]]
-  :plugins [[lein-cljsbuild "1.0.5"]]
+  :plugins [[lein-cljsbuild "1.0.6"]]
   :source-paths ["src"]
   :clean-targets ["target" "out"]
   :cljsbuild {:builds {:dev


Add schema checks to set-env! to ensure correct types (fixes #59)

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -169,6 +169,7 @@
 (defn- add-dependencies!
   "Add Maven dependencies to the classpath, fetching them if necessary."
   [old new env]
+  (assert (vector? new) "env :dependencies must be a vector")
   (->> new rm-clojure-dep (assoc env :dependencies) pod/add-dependencies)
   (set-fake-class-path!)
   new)
@@ -194,6 +195,7 @@
   ([maven-coord scheme-map]
    (add-wagon! nil [maven-coord] (get-env) scheme-map))
   ([old new env]
+   (assert (vector? new) "env :wagons must be a vector")
    (add-wagon! old new env nil))
   ([old new env scheme-map]
    (doseq [maven-coord new]
@@ -499,10 +501,15 @@
   associated with the given `key` in the boot atom."
   (fn [key old-value new-value env] key) :default ::default)

-(defmethod merge-env! ::default     [key old new env] new)
-(defmethod merge-env! :directories  [key old new env] (set/union old new))
-(defmethod merge-env! :wagons       [key old new env] (add-wagon! old new env))
-(defmethod merge-env! :dependencies [key old new env] (add-dependencies! old new env))
+(defn- assert-set [k new] (assert (set? new) (format "env %s must be a set" k)))
+
+(defmethod merge-env! ::default       [key old new env] new)
+(defmethod merge-env! :directories    [key old new env] (set/union old new))
+(defmethod merge-env! :source-paths   [key old new env] (assert-set key new) new)
+(defmethod merge-env! :resource-paths [key old new env] (assert-set key new) new)
+(defmethod merge-env! :asset-paths    [key old new env] (assert-set key new) new)
+(defmethod merge-env! :wagons         [key old new env] (add-wagon! old new env))
+(defmethod merge-env! :dependencies   [key old new env] (add-dependencies! old new env))

 (defn get-env
   "Returns the value associated with the key `k` in the boot environment, or


Add non-cmd-items to history

Add non-cmd-items to history

--- src/yetibot/core/models/history.clj
+++ src/yetibot/core/models/history.clj
@@ -33,6 +33,19 @@
 (defn items-for-user [{:keys [chat-source user]}]
   (filter #(= (-> % :user :id) (:id user)) (items-with-user chat-source)))

+
+;; non-cmd history
+(def ^:private history-ignore #"^\!")
+
+(defn non-cmd-items
+  "Return `chat-item` only if it doesn't match any regexes in `history-ignore`"
+  [chat-source]
+  (->> (history)
+       (take-last 100)
+       reverse
+       (filter (fn [[_ body]] (not (re-find history-ignore body))))
+       first))
+
 ;;;; write

 (defn add [{:keys [user-id body] :as history-item}]


Fixed bug in SSL connector

Fixed bug in SSL connector

--- ring-jetty-adapter/src/ring/adapter/jetty.clj
+++ ring-jetty-adapter/src/ring/adapter/jetty.clj
@@ -34,7 +34,8 @@
       (.setTrustPassword ssl-connector (options :trust-password)))
     (case (options :client-auth)
       :need (.setNeedClientAuth ssl-connector true)
-      :want (.setWantClientAuth ssl-connector true))
+      :want (.setWantClientAuth ssl-connector true)
+      nil)
     (.addConnector server ssl-connector)))

 (defn- create-server


Added providers map.

Added providers map.

--- web/src/sound_effector/models/user.clj
+++ web/src/sound_effector/models/user.clj
@@ -1,6 +1,15 @@
 (ns sound-effector.models.user
   (:require [clojure.java.jdbc :as sql]
             [sound-effector.core :refer [db-spec]]))
+
+(defn- make-providers [id]
+  (loop [providers (sql/query db-spec ["SELECT provider_id, provider_user_id FROM user_providers WHERE user_id = ?" id])
+         result {}]
+    (if (nil? providers)
+      result
+      (let [provider (first providers)]
+        (recur (next providers)
+               (assoc result (:provider_id provider) (:provider_user_id provider)))))))

 (defn create [name email provider-id provider-user-id]
   (sql/with-db-transaction
@@ -12,10 +21,12 @@
                    :user_providers {:user_id          (:id user)
                                     :provider_id      provider-id
                                     :provider_user_id provider-user-id})
-      user)))
+      (assoc user :providers (make-providers (:id user))))))

 (defn read
   ([id]
-   (first (sql/query db-spec ["SELECT * FROM users WHERE id = ?" id])))
+   (let [user (first (sql/query db-spec ["SELECT * FROM users WHERE id = ?" id]))]
+     (assoc user :providers (make-providers (:id user)))))
   ([provider-id provider-user-id]
-   (first (sql/query db-spec ["SELECT a.* FROM users a JOIN user_providers b ON (b.provider_id = ? AND b.provider_user_id = ? AND b.user_id = a.id)" provider-id provider-user-id]))))
+   (let [user (first (sql/query db-spec ["SELECT a.* FROM users a JOIN user_providers b ON (b.provider_id = ? AND b.provider_user_id = ? AND b.user_id = a.id)" provider-id provider-user-id]))]
+     (assoc user :providers (make-providers (:id user))))))


Delete non-bib files

Delete non-bib files

--- resources/public/lprefs.clj
+++ resources/public/lprefs.clj
@@ -1,47 +0,0 @@
-{
-:afar "afr"
-:akkadian-ob "aob"
-:alaaba "alb"
-:arabic "arb"
-:arbore "abr"
-:awngi "awn"
-:bayso "bay"
-:beja-arteiga "bar"
-:beja-atmaan "bat"
-:beja-beniamer "bbe"
-:beja-bishari "bbi"
-:beja-hadendowa "bha"
-:bilin "bil"
-:boni-jara "boj"
-:boni-kilii "bok"
-:boni-kijee-bala "bob"
-:burji "bur"
-:burunge "brn"
-:coptic-sahidic "csa"
-:dahalo "dah"
-:dhaasanac "dha"
-:dizi "diz"
-:egyptian-middle "egm"
-:elmolo "elm"
-:gawwada "gaw"
-:gedeo "ged"
-:geez "gez"
-:hadiyya "had"
-:hebrew "heb"
-:iraqw "irq"
-:kambaata "kam"
-:kemant "kem"
-:khamtanga "khm"
-:koorete "kor"
-:maale "mal"
-:oromo "orm"
-:rendille "ren"
-:saho "sah"
-:shinassha "shn"
-:sidaama "sid"
-:somali-standard "sst"
-:syriac "syr"
-:tsamakko "tsm"
-:wolaytta "wol"
-:yaaku "yak"
-:yemsa "yem"}


Added not=

Added not=

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1089,6 +1089,13 @@
            (. f apply f (to-array args))
            (. f apply f (to-array args))) ;; applyTo
          (. f apply f (to-array args))))))
+
+(defn not=
+  "Same as (not (= obj1 obj2))"
+  ([x] false)
+  ([x y] (not (= x y)))
+  ([x y & more]
+   (not (apply = x y more))))

 (defn every?
   "Returns true if (pred x) is logical true for every x in coll, else
@@ -2252,6 +2259,10 @@
     (assert (= [1 2] (for [e v :while (< e 3)] e)))
     (assert (= [3] (for [e v :when (> e 2)] e)))
     (assert (= [[1 1] [2 4]] (for [e v :while (< e 3) :let [m (* e e)]] [e m]))))
+  (assert (not= 1 2))
+  (assert (not (not= 1 1)))
+;;  (assert (distinct? 1 2 3))
+;;  (assert (not (distinct? 1 2 3 3)))
   :ok
   )