improved ex idents

improved ex idents

--- src/cljs/daveconservatoire/site/ui/exercises.cljs
+++ src/cljs/daveconservatoire/site/ui/exercises.cljs
@@ -14,6 +14,7 @@
 (s/def ::progress-total number?)
 (s/def ::react-component object?)

+(s/def ::name string?)
 (s/def ::description string?)
 (s/def ::option (s/cat :value string? :label string?))
 (s/def ::options (s/or :text #{::option-type-text}
@@ -38,7 +39,7 @@
 (s/def ::variation ::value-descriptor)
 (s/def ::direction ::value-descriptor)
 (s/def ::intervals (s/every ::audio/semitone))
-(s/def ::random-direction? boolean?)
+(s/def ::direction? #{-1 1})

 (om/defui ^:once ProgressBar
   Object
@@ -106,7 +107,7 @@
   (query [_] ['*])

   static om/Ident
-  (ident [_ props] (om/ident (::parent props) props))
+  (ident [_ props] [:exercise/by-name (::name props)])

   Object
   (render [this]
@@ -195,14 +196,15 @@
     (new-round this
       (merge
         (uc/initial-state Exercise nil)
-        {::options   [["lower" "Lower"] ["higher" "Higher"]]
+        {::name      "pitch-detection"
+         ::options   [["lower" "Lower"] ["higher" "Higher"]]
          ::pitch     ["C3" ".." "B5"]
          ::variation 24
          ::parent    this}
         props)))

   static om/Ident
-  (ident [_ props] [:exercise/by-name "pitch"])
+  (ident [_ props] [:exercise/by-name (::name props)])

   static om/IQuery
   (query [_] '[*])
@@ -217,7 +219,7 @@
   Object
   (render [this]
     (exercise (om/props this)
-      (dom/p nil "You will hear two notes. Is the second note lower or higher in pitch?"))))
+      (dom/p #js {:key "p"} "You will hear two notes. Is the second note lower or higher in pitch?"))))

 (om/defui ^:once IdentifyOctaves
   static uc/InitialAppState
@@ -225,14 +227,15 @@
     (new-round this
       (merge
         (uc/initial-state Exercise nil)
-        {::options   [["yes" "Yes"] ["no" "No"]]
+        {::name      "identify-octaves"
+         ::options   [["yes" "Yes"] ["no" "No"]]
          ::pitch     ["C3" ".." "B5"]
          ::variation [3 5 6 7 8 9 12 15 16]
          ::parent    this}
         props)))

   static om/Ident
-  (ident [_ props] [:exercise/by-name "octaves"])
+  (ident [_ props] [:exercise/by-name (::name props)])

   static om/IQuery
   (query [_] '[*])
@@ -249,7 +252,7 @@
   Object
   (render [this]
     (exercise (om/props this)
-      (dom/p nil "You will hear two notes. Are they an octave apart?"))))
+      (dom/p #js {:key "p"} "You will hear two notes. Are they an octave apart?"))))

 (om/defui ^:once ReadingMusic
   static uc/InitialAppState
@@ -257,12 +260,13 @@
     (new-round this
       (merge
         (uc/initial-state Exercise nil)
-        {::options ::option-type-text
+        {::name    "reading-music"
+         ::options ::option-type-text
          ::parent  this}
         props)))

   static om/Ident
-  (ident [_ props] [:exercise/by-name "reading-music"])
+  (ident [_ props] [:exercise/by-name (::name props)])

   static om/IQuery
   (query [_] '[*])
@@ -303,14 +307,15 @@
       (let [intervals (get props ::intervals [12 7 4 5 9 2 11])]
         (merge
           (uc/initial-state Exercise nil)
-          {::options   (mapv #(vector (str %) (INTERVAL-NAMES %)) intervals)
+          {::name      "intervals"
+           ::options   (mapv #(vector (str %) (INTERVAL-NAMES %)) intervals)
            ::pitch     ["C3" ".." "B5"]
            ::variation intervals
            ::parent    this}
           props))))

   static om/Ident
-  (ident [_ props] [:exercise/by-name "intervals"])
+  (ident [_ props] [:exercise/by-name (::name props)])

   static om/IQuery
   (query [_] '[*])
@@ -326,160 +331,189 @@
   Object
   (render [this]
     (exercise (om/props this)
-      (dom/p nil "You will hear two notes - what is their interval?"))))
+      (dom/p #js {:key "p"} "You will hear two notes - what is their interval?"))))

 (defmulti slug->exercise identity)

 (defmethod slug->exercise :default [_] nil)

-(defmethod slug->exercise "pitch-1" [_]
-  {::class PitchDetection
+(defmethod slug->exercise "pitch-1" [name]
+  {::name  name
+   ::class PitchDetection
    ::props {::variation [12 ".." 24]}})

-(defmethod slug->exercise "pitch-2" [_]
-  {::class PitchDetection
+(defmethod slug->exercise "pitch-2" [name]
+  {::name  name
+   ::class PitchDetection
    ::props {::variation [8 ".." 16]}})

-(defmethod slug->exercise "pitch-3" [_]
-  {::class PitchDetection
+(defmethod slug->exercise "pitch-3" [name]
+  {::name  name
+   ::class PitchDetection
    ::props {::variation [1 ".." 9]}})

-(defmethod slug->exercise "identifying-octaves" [_]
-  {::class IdentifyOctaves
+(defmethod slug->exercise "identifying-octaves" [name]
+  {::name  name
+   ::class IdentifyOctaves
    ::props {}})

-(defmethod slug->exercise "treble-clef-reading" [_]
-  {::class ReadingMusic
+(defmethod slug->exercise "treble-clef-reading" [name]
+  {::name  name
+   ::class ReadingMusic
    ::props {}})

-(defmethod slug->exercise "intervals-1" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-1" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7]
             ::pitch     ["C3" "C4" "C5"]
             ::direction 1}})

-(defmethod slug->exercise "intervals-2" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-2" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4]
             ::pitch     ["C3" "C4" "C5"]
             ::direction 1}})

-(defmethod slug->exercise "intervals-3" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-3" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5]
             ::pitch     ["C3" "C4" "C5"]
             ::direction 1}})

-(defmethod slug->exercise "intervals-4" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-4" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9]
             ::pitch     ["C3" "C4" "C5"]
             ::direction 1}})

-(defmethod slug->exercise "intervals-5" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-5" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2]
             ::pitch     ["C3" "C4" "C5"]
             ::direction 1}})

-(defmethod slug->exercise "intervals-6" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-6" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2 11]
             ::pitch     ["C3" "C4" "C5"]
             ::direction 1}})

-(defmethod slug->exercise "intervals-7" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-7" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7]
             ::direction 1}})

-(defmethod slug->exercise "intervals-8" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-8" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4]
             ::direction 1}})

-(defmethod slug->exercise "intervals-9" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-9" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5]
             ::direction 1}})

-(defmethod slug->exercise "intervals-10" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-10" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9]
             ::direction 1}})

-(defmethod slug->exercise "intervals-11" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-11" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2]
             ::direction 1}})

-(defmethod slug->exercise "intervals-12" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-12" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2 11]
             ::direction 1}})

-(defmethod slug->exercise "intervals-13" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-13" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7]
             ::pitch     ["C3" "C4" "C5"]
             ::direction -1}})

-(defmethod slug->exercise "intervals-14" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-14" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4]
             ::pitch     ["C3" "C4" "C5"]
             ::direction -1}})

-(defmethod slug->exercise "intervals-15" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-15" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5]
             ::pitch     ["C3" "C4" "C5"]
             ::direction -1}})

-(defmethod slug->exercise "intervals-16" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-16" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9]
             ::pitch     ["C3" "C4" "C5"]
             ::direction -1}})

-(defmethod slug->exercise "intervals-17" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-17" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2]
             ::pitch     ["C3" "C4" "C5"]
             ::direction -1}})

-(defmethod slug->exercise "intervals-18" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-18" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2 11]
             ::pitch     ["C3" "C4" "C5"]
             ::direction -1}})

-(defmethod slug->exercise "intervals-19" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-19" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7]
             ::direction -1}})

-(defmethod slug->exercise "intervals-20" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-20" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4]
             ::direction -1}})

-(defmethod slug->exercise "intervals-21" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-21" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5]
             ::direction -1}})

-(defmethod slug->exercise "intervals-22" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-22" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9]
             ::direction -1}})

-(defmethod slug->exercise "intervals-23" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-23" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2]
             ::direction -1}})

-(defmethod slug->exercise "intervals-24" [_]
-  {::class Intervals
+(defmethod slug->exercise "intervals-24" [name]
+  {::name  name
+   ::class Intervals
    ::props {::intervals [12 7 4 5 9 2 11]
             ::direction -1}})


Fix scroll-back issue

Fix scroll-back issue

--- src/retouch/views/swipe.cljs
+++ src/retouch/views/swipe.cljs
@@ -28,8 +28,8 @@
            :vertical-align "top" }]]])]))

 (defn swipe-view [panel-items panel-view]
-  (let [state (atom {:panel-count (count panel-items)
-                     :container nil
+  (let [panel-count (r/atom (count panel-items))
+        state (atom {:container nil
                      :dragging? false
                      :scroll-x-start nil})

@@ -57,7 +57,7 @@
                                      (-> x
                                          (min xmax)
                                          (max xmin)))
-                             target-n (bound (+ start-n delta-n) 0 (dec (@state :panel-count)))
+                             target-n (bound (+ start-n delta-n) 0 (dec @panel-count))
                              target-x (* width target-n)]

                         (set! (.-scrollLeft (@state :container)) target-x)))
@@ -87,7 +87,7 @@
          (swap! state assoc :container (r/dom-node component)))
        :component-will-update
        (fn [this _]
-         (swap! state assoc :panel-count (count (first (r/children this)))))
+         (reset! panel-count (count (first (r/children this)))))
        :component-will-unmount
        (fn []
          (.removeEventListener js/document "touchend" touch-end!)


better error stream handling

better error stream handling

--- src-cljs/cljsbuild_ui/exec.cljs
+++ src-cljs/cljsbuild_ui/exec.cljs
@@ -154,44 +154,49 @@
 (defn- on-console-output
   "This function gets called with chunks of text from the compiler console output.
    It parses them using regex and puts the results onto a core.async channel."
-  [text1 c error-msg inside-error?]
-  (let [text2 (trim text1)
-        output-type (determine-output-type text2)]
-
-    ; (js-log "raw output:")
-    ; (js-log text2)
-    ; (if output-type
-    ;   (js-log (str "### output type: " output-type)))
-    ; (js-log "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
+  [raw-output c inside-error? err-msg-buffer err-msg-timeout]
+  (let [trimmed-output (trim raw-output)
+        output-type (determine-output-type trimmed-output)]
+
+    (js-log "raw output:")
+    (js-log trimmed-output)
+    (if output-type
+      (js-log (str "### output type: " output-type)))
+    (js-log "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")

     ;; close the error sequence if we catch any signal
     (when (and output-type @inside-error?)
+      (js/clearTimeout @err-msg-timeout)
       (reset! inside-error? false)
-      (put! c [:error (extract-error-msg @error-msg)]))
+      (put! c [:error (extract-error-msg @err-msg-buffer)]))

     ;; concatenate error message
     (when @inside-error?
-      (swap! error-msg str text1))
+      (swap! err-msg-buffer str raw-output "\n"))

     ;; start error signal
     (when (= output-type :start-error)
       (reset! inside-error? true)
-      (reset! error-msg text2)
+      (reset! err-msg-buffer raw-output)
+
       ;; send an "end error" signal 25ms from start of the error
-      (js/setTimeout
-        #(on-console-output end-error-msg c error-msg inside-error?) 25))
+      (let [t (js/setTimeout
+                #(on-console-output end-error-msg c inside-error?
+                   err-msg-buffer err-msg-timeout)
+                25)]
+        (reset! err-msg-timeout t)))

     ;; start compiling signal
     (when (= output-type :start)
-      (put! c [:start (extract-target-from-start-msg text2)]))
+      (put! c [:start (extract-target-from-start-msg trimmed-output)]))

     ;; compilation success
     (when (= output-type :success)
-      (put! c [:success (extract-time-from-success-msg text2)]))
+      (put! c [:success (extract-time-from-success-msg trimmed-output)]))

     ;; warnings
     (when (= output-type :warning)
-      (put! c [:warning (extract-warning-msgs text2)]))))
+      (put! c [:warning (extract-warning-msgs trimmed-output)]))))

 (defn- on-close-child [c]
   (put! c [:finished])
@@ -247,12 +252,15 @@
   [prj-key bld-ids]
   (let [c (chan)
         child (spawn "lein cljsbuild auto" (convert-cwd prj-key))
-        error-msg (atom "")
-        inside-error? (atom false)]
+        inside-error? (atom false)
+        err-msg-buffer (atom "")
+        err-msg-timeout (atom nil)]
     (.setEncoding (.-stderr child) "utf8")
     (.setEncoding (.-stdout child) "utf8")
-    (.on (.-stderr child) "data" #(on-console-output % c error-msg inside-error?))
-    (.on (.-stdout child) "data" #(on-console-output % c error-msg inside-error?))
+    (.on (.-stderr child) "data"
+      #(on-console-output % c inside-error? err-msg-buffer err-msg-timeout))
+    (.on (.-stdout child) "data"
+      #(on-console-output % c inside-error? err-msg-buffer err-msg-timeout))
     (.on child "close" #(on-close-child c))

     ;; save the child pid
@@ -279,12 +287,15 @@
   [prj-key bld-ids]
   (let [c (chan)
         child (spawn "lein cljsbuild once" (convert-cwd prj-key))
-        error-msg (atom "")
-        inside-error? (atom false)]
+        inside-error? (atom false)
+        err-msg-buffer (atom "")
+        err-msg-timeout nil]
     (.setEncoding (.-stderr child) "utf8")
     (.setEncoding (.-stdout child) "utf8")
-    (.on (.-stderr child) "data" #(on-console-output % c error-msg inside-error?))
-    (.on (.-stdout child) "data" #(on-console-output % c error-msg inside-error?))
+    (.on (.-stderr child) "data"
+      #(on-console-output % c inside-error? err-msg-buffer err-msg-timeout))
+    (.on (.-stdout child) "data"
+      #(on-console-output % c inside-error? err-msg-buffer err-msg-timeout))
     (.on child "close" #(on-close-child c))
     ;; return the channel
     c))


Removing landscapes legend

Removing landscapes legend

--- src/amindblowingworld/view_index.clj
+++ src/amindblowingworld/view_index.clj
@@ -55,8 +55,8 @@
               [:h3 "World Map"]
               [:img#worldMap {:src "/img/ancient.png"}]]
             [:div#menu.column
-              [:h3 "Landscapes"]
-              [:table (landscape-colors-legend)]
+              ;[:h3 "Landscapes"]
+              ;[:table (landscape-colors-legend)]
               [:h3 "Make damage!"]
               [:form#damageReasons (damage-reasons ["Vulcano"] true) (damage-reasons ["Earthquake" "Hunger" "Tsunami" "Tornado" "Meteor" "Russian invasion" "Crazy Putin"] false)]]
             [:div#news.column


use promises

use promises

--- worker/src/worker/core.cljs
+++ worker/src/worker/core.cljs
@@ -33,25 +33,35 @@
     (.postMessage w (cljs.core/clj->js [(:ns wmeta) (:name wmeta)]))
     {:w w :result result}))

+(defn do-some-pr []
+  (js/Promise. (fn [res rej]
+    (let [w (js/Worker. (.createObjectURL js/URL worker.worker/worker-blob))
+          wmeta (meta (var wrk))]
+      (set! (.-onmessage w) #(res (worker.worker/*deserialize* (.-data %))))
+      (.postMessage w (cljs.core/clj->js [(:ns wmeta) (:name wmeta)]))))))
+
 (defn ^:export main []
   (enable-console-print!)
   (def strt (.getTime (js/Date.)))

-  (def w1 (do-some))
-  (def w2 (do-some))
-  (def w3 (do-some))
-  (def w4 (do-some))
-  (add-watch (:result w1) nil #(println (- (.getTime (js/Date.)) strt)))
-  (add-watch (:result w2) nil #(println (- (.getTime (js/Date.)) strt)))
-  (add-watch (:result w3) nil #(println (- (.getTime (js/Date.)) strt)))
-  (add-watch (:result w4) nil #(println (- (.getTime (js/Date.)) strt)))
-  (wrk)
-  (println (- (.getTime (js/Date.)) strt))
-  (wrk)
-  (println (- (.getTime (js/Date.)) strt))
-  (wrk)
-  (println (- (.getTime (js/Date.)) strt))
-  (wrk)
-  (println (- (.getTime (js/Date.)) strt))
+  (.then (do-some-pr) #(println (- (.getTime (js/Date.)) strt)))
+  (.then (do-some-pr) #(println (- (.getTime (js/Date.)) strt)))
+  (.then (do-some-pr) #(println (- (.getTime (js/Date.)) strt)))
+  ; (def w1 (do-some))
+  ; (def w2 (do-some))
+  ; (def w3 (do-some))
+  ; (def w4 (do-some))
+  ; (add-watch (:result w1) nil #(println (- (.getTime (js/Date.)) strt)))
+  ; (add-watch (:result w2) nil #(println (- (.getTime (js/Date.)) strt)))
+  ; (add-watch (:result w3) nil #(println (- (.getTime (js/Date.)) strt)))
+  ; (add-watch (:result w4) nil #(println (- (.getTime (js/Date.)) strt)))
+  ; (wrk)
+  ; (println (- (.getTime (js/Date.)) strt))
+  ; (wrk)
+  ; (println (- (.getTime (js/Date.)) strt))
+  ; (wrk)
+  ; (println (- (.getTime (js/Date.)) strt))
+  ; (wrk)
+  ; (println (- (.getTime (js/Date.)) strt))

   )


Add `!` suffix to `add-module-lesson`

Add `!` suffix to `add-module-lesson`

Because it results in a side effect

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -340,7 +340,7 @@

    	")

-(defn- add-new-row-to-timetable-day
+(defn- add-new-row-to-timetable-day!
   "Adds a new row to the 0-indexed day in the Timetable, where 0 = Monday,
    1 = Tuesday, until 4 = Friday."
   [day]
@@ -431,7 +431,7 @@
     [(str "h" (if (< hour 10) "0" "") hour)
      (str "m" (if (not= minute 0) "30" "00"))]))

-(defn- add-module-lesson
+(defn- add-module-lesson!
   "Adds a single lesson of a module (obtained from the `ModulesMap` global) to
    the timetable, and returns its jQuery div element."
   [moduleCode moduleName lessonType lessonLabel modulesMapLesson bgColorCssClass
@@ -447,7 +447,7 @@
         (get-css-hour-minute-classes-for-time startTime)]
     ; Create new row if necessary
     (if (= rowNum (get-nr-rows-in-timetable-day day))
-        (add-new-row-to-timetable-day day))
+        (add-new-row-to-timetable-day! day))

     ; Update in-memory representation of timetable
     (timetable-add-lesson day
@@ -664,13 +664,13 @@
     (if (and moduleName modulesMapLessonSeq)
         (let [augLessonInfoSeq
               (doall (map (fn [modulesMapLesson]
-                            (add-module-lesson moduleCode moduleName
-                                                          lessonType
-                                                          lessonLabel
-                                                          modulesMapLesson
-                                                          bgColorCssClass
-                                                          isActuallySelected?))
-                                    modulesMapLessonSeq))
+                            (add-module-lesson! moduleCode moduleName
+                                                           lessonType
+                                                           lessonLabel
+                                                           modulesMapLesson
+                                                           bgColorCssClass
+                                                           isActuallySelected?))
+                          modulesMapLessonSeq))
               lessonInfoSeq (map #(dissoc %1 :divElem :moduleCode :lessonType
                                           :lessonGroup)
                                  augLessonInfoSeq)
@@ -913,7 +913,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- add-missing-td-elements-replacing-lesson
-  "Adds  elements that were removed by the `add-module-lesson` function
+  "Adds  elements that were removed by the `add-module-lesson!` function
    to make way for the lesson."
   [$parentTd ttLessonInfo]
   (let [startTime (:startTime ttLessonInfo)


Move helper functions into letfn

Move helper functions into letfn

--- src/cljs/early_vote_site/places.cljs
+++ src/cljs/early_vote_site/places.cljs
@@ -3202,30 +3202,27 @@
   ([fips]
    (get fips->name fips fips)))

-(defn county-fips?
-  "Returns true if the fips looks like a county fips (has 5 characters)"
-  [fips]
-  (= 5 (count fips)))
-
-(defn in-state?
-  "Returns true if the candidate fips is in the same state as the state fips"
-  [state-fips candidate-fips]
-  (str/starts-with? candidate-fips state-fips))
-
 (defn county-list
   "Given a state fips, returns a vector of vectors like:
   [[\"01001\" \"Autauga County\"]
    [\"01003\" \"Baldwin County\"]
    ...]

-  The order is defined by the order of the county fips codes."
+  The order is defined by the order of the county fips codes.
+  The counties come from the fips->name map."
   [state-fips]
-  (let [county-keys (->> (keys fips->name)
-                         (filter #(and (in-state? state-fips %)
-                                       (county-fips? %)))
-                         sort)
-        county-names (map fips->name county-keys)]
-    (mapv vector county-keys county-names)))
+  (letfn [(in-state? [candidate-fips]
+            (str/starts-with? candidate-fips state-fips))
+          (county-fips? [candidate-fips]
+            (= 5 (count candidate-fips)))
+          (county-fips-for-state? [candidate-fips]
+            (and (in-state? candidate-fips)
+                 (county-fips? candidate-fips)))]
+    (let [county-keys (->> (keys fips->name)
+                           (filter county-fips-for-state?)
+                           sort)
+          county-names (map fips->name county-keys)]
+      (mapv vector county-keys county-names))))

 (def state-fips->abbreviation
   {"01" "AL"


Fix empty configuration handling.

Fix empty configuration handling.

--- src/clojure/uk/org/il2ssd/config.clj
+++ src/clojure/uk/org/il2ssd/config.clj
@@ -72,8 +72,8 @@

   nil
   (build-conf
-    ([this file] file)
-    ([this newln? file] file))
+    ([this file] "")
+    ([this newln? file] ""))

   String
   (build-conf
@@ -96,7 +96,7 @@
                              (for [setting (reverse this)
                                    :let [[key value] setting]]
                                (str key " = " value)))
-                     file))))
+                     ""))))

   PersistentVector
   (build-conf [this file]
@@ -107,7 +107,7 @@
                              (for [setting (reverse (map-indexed #(vector (inc %) %2) this))
                                    :let [[key value] setting]]
                                (string/replace (str key " = " value) "\"" "")))
-                     file)))))
+                     "")))))

 (defn save-server
   "### save-server


Add convenience (cljs-repl) function to one.sample.repl.

--- src/app/clj/one/sample/repl.clj
+++ src/app/clj/one/sample/repl.clj
@@ -23,6 +23,13 @@
   (future (Thread/sleep 3000)
           (browse/browse-url "http://localhost:8080")))

+;; This is a convenience function so that people can start a CLJS REPL
+;; without having to type in (tools/cljs-repl)
+(defn cljs-repl
+  "Start a ClojureScript REPL."
+  []
+  (tools/cljs-repl))
+
 (println)
 (println "Type (go) to launch the development server and setup a browser-connected REPL.")
 (println "Type (dev-server) to launch only the development server.")


Return also route-data

Return also route-data

--- perf-test/clj/reitit/trie.cljc
+++ perf-test/clj/reitit/trie.cljc
@@ -37,7 +37,9 @@
   (lookup [_ _ _])
   (get-segment [this]))

-(defn wild-node [segment param children]
+(defrecord Match [data params])
+
+(defn wild-node [segment param children data]
   (let [?wild (maybe-wild-node children)
         ?catch (maybe-catch-all-node children)
         children' (impl/fast-map children)]
@@ -53,23 +55,23 @@
                 (or (lookup child path' params)
                     (lookup ?wild path' params)
                     (lookup ?catch path' params))))
-            (assoc params param path))))
+            (->Match data (assoc params param path)))))
       (get-segment [this]
         segment)
       (add-child [this key child]
-        (wild-node segment param (assoc children key child)))
+        (wild-node segment param (assoc children key child) data))
       (insert-child [this key path-spec o]
-        (wild-node segment param (update children key insert path-spec o))))))
-
-(defn catch-all-node [segment children param]
+        (wild-node segment param (update children key insert path-spec o) data)))))
+
+(defn catch-all-node [segment children param data]
   (reify
     Node
     (lookup [this path params]
-      (assoc params param path))
+      (->Match data (assoc params param path)))
     (get-segment [this]
       segment)))

-(defn static-node [^String segment children]
+(defn static-node [^String segment children data]
   (let [size (count segment)
         ?wild (maybe-wild-node children)
         ?catch (maybe-catch-all-node children)
@@ -78,7 +80,7 @@
       Node
       (lookup [this path params]
         (if (.equals segment path)
-          params
+          (->Match data params)
           (let [p (if (>= (count path) size) (subs path 0 size))]
             (if (.equals segment p)
               (let [child (impl/fast-get children' (char-key path size))
@@ -89,11 +91,11 @@
       (get-segment [this]
         segment)
       (update-segment [this subs lcs]
-        (static-node (subs segment lcs) children))
+        (static-node (subs segment lcs) children data))
       (add-child [this key child]
-        (static-node segment (assoc children key child)))
+        (static-node segment (assoc children key child) data))
       (insert-child [this key path-spec o]
-        (static-node segment (update children key insert path-spec o))))))
+        (static-node segment (update children key insert path-spec o) data)))))

 (defn- wild? [s]
   (contains? #{\: \*} (first s)))
@@ -139,13 +141,13 @@
   [segment o]
   (cond
     (wild-param? segment)
-    (wild-node segment (keyword (subs segment 1)) nil)
+    (wild-node segment (keyword (subs segment 1)) nil o)

     (catch-all-param? segment)
-    (catch-all-node segment (keyword (subs segment 1)) nil)
+    (catch-all-node segment (keyword (subs segment 1)) nil o)

     :else
-    (static-node segment nil)))
+    (static-node segment nil o)))

 (defn- new-node
   "Given a path-spec and a payload object, return a new tree node. If
@@ -318,4 +320,5 @@
   ;; 1.3ms (dissoc wild & catch-all from children)
   ;; 1.3ms (reified protocols)
   ;; 0.8ms (flattened matching)
+  ;; 0.8ms (return route-data)
   (cc/quick-bench (dotimes [_ 1000] (lookup tree-new "/v1/orgs/1/topics" {}))))


refactor index-building so it can work on all models

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -27,11 +27,11 @@
    [:synsem :cat]
    [:synsem :sem :pred]])

-(defn index-by-paths [lexicon]
-  (map (fn [path]
-         {:path path
-          :lexemes (map-subset-by-path lexicon path)})
-       index-lexicon-on-paths))
+(defn create-indices [lexicon]
+  (into {}
+        (map (fn [path]
+               [path (map-subset-by-path lexicon path)])
+             index-lexicon-on-paths)))

 (defn fo-ps [expr]
   (parse/fo-ps expr fo))
@@ -713,15 +713,6 @@
      :generate {:lexicon lexicon-for-generation}
      :grammar grammar
      :lexicon lexicon
-     :aux2lex ;; map:<pred => subset of lexicon with that pred>
-     (map-subset-by-path lexicon-for-generation [:synsem :aux])
-
-     :pred2lex ;; map:<pred => subset of lexicon with that pred>
-     (map-subset-by-path lexicon-for-generation [:synsem :sem :pred])
-
-     :cat2lex ;; map:<cat => subset of lexicon with that cat>
-     (map-subset-by-path lexicon-for-generation [:synsem :cat])
-
      :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
      :lookup (fn [arg]
                (analyze arg lexicon))
@@ -769,6 +760,25 @@
     (log/debug (str "micro lexicon size:" (count (keys micro-lexicon))))
     (clojure.core/merge small
                         {:lexicon micro-lexicon})))
+
+(defn lookup-spec [spec indices]
+  (log/debug (str "index-fn called with spec: "
+                  (strip-refs
+                   (dissoc (strip-refs spec)
+                           :dag_unify.core/serialized))))
+  (let [result
+        (reduce intersection-with-identity
+                (filter #(not (empty? %))
+                        (map (fn [path]
+                               (let [result
+                                     (get (get indices path)
+                                          (get-in spec path ::undefined))]
+                                 (log/trace (str "subset for path:" path " => " (get-in spec path ::undefined)
+                                                 " = " (count result)))
+                                 result))
+                             index-lexicon-on-paths)))]
+    (log/debug (str "indexed size returned: " (count result)))
+    result))

 (defn medium []
   (deliver-lexicon)
@@ -796,63 +806,12 @@
         rules (map #(keyword (get-in % [:rule])) grammar)

         ;; indices from paths to subsets of the lexicon
-        aux2lex (map-subset-by-path lexicon-for-generation [:synsem :aux])
-        pred2lex (map-subset-by-path lexicon-for-generation [:synsem :sem :pred])
-        cat2lex (map-subset-by-path lexicon-for-generation [:synsem :cat])
-
-        indices
-        (into {}
-              (map (fn [path]
-                     [path (map-subset-by-path lexicon-for-generation path)])
-                   [[:italiano :italiano]]))]
+        indices (create-indices lexicon-for-generation)]

     {:name "medium"
      :generate {:lexicon lexicon-for-generation}
      :grammar grammar
-     :index-fn (fn [spec]
-                 (do (log/debug (str "index-fn called with spec: "
-                                    (strip-refs
-                                     (dissoc (strip-refs spec)
-                                             :dag_unify.core/serialized))))
-                     (log/debug (str "aux2lex: " (count
-                                                  (get aux2lex (get-in spec [:synsem :aux]
-                                                                       ::undefined)))))
-                     (log/debug (str "cat2lex: " (count
-                                                  (get cat2lex (get-in spec [:synsem :cat]
-                                                                       ::undefined)))))
-                     (log/debug (str "pred2lex: " (count
-                                                   (get pred2lex (get-in spec [:synsem :sem :pred]
-                                                                         ::undefined)))))
-                     (log/trace (str "aux2lex: " (clojure.string/join
-                                                  ","
-                                                  (sort (map #(fo %)
-                                                             (get aux2lex (get-in spec [:synsem :aux]
-                                                                                ::undefined)))))))
-                     (log/trace (str "cat2lex: " (clojure.string/join
-                                                  ","
-                                                  (sort (map #(fo %)
-                                                             (get cat2lex (get-in spec [:synsem :cat]
-                                                                                ::undefined)))))))
-                     (log/trace (str "pred2lex: " (clojure.string/join
-                                                   ","
-                                                   (sort (map #(fo %)
-                                                              (get pred2lex (get-in spec [:synsem :sem :pred]
-                                                                                ::undefined)))))))
-                     (let [result
-                           (reduce intersection-with-identity
-                                   (filter #(not (empty? %))
-                                           (concat
-                                            (map (fn [path]
-                                                   (get (get indices path)
-                                                        (get-in spec path ::undefined)))
-                                                 [[:italiano :italiano]])
-                                            [(get pred2lex (get-in spec [:synsem :sem :pred] ::undefined))
-                                             (get aux2lex (get-in spec [:synsem :aux] ::undefined))
-                                             (get cat2lex (get-in spec [:synsem :cat] ::undefined))
-                                             ])))]
-                       (log/debug (str "indexed size returned: " (count result)))
-                       result)))
-
+     :index-fn (fn [spec] (lookup-spec spec indices))
      :language "it"
      :language-keyword :italiano
      :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
@@ -922,16 +881,5 @@
        :lexicon lexicon
        :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
        :rules rules
-       :rule-map (zipmap rules grammar)
-
-       ;; indices from paths to subsets of the lexicon
-       :aux2lex
-       (map-subset-by-path lexicon-for-generation [:synsem :aux])
-
-       :pred2lex ;; map:<pred => subset of lexicon with that pred>
-       (map-subset-by-path lexicon-for-generation [:synsem :sem :pred])
-
-       :cat2lex ;; map:<cat => subset of lexicon with that cat>
-       (map-subset-by-path lexicon-for-generation [:synsem :cat])}))
-
-
+       :rule-map (zipmap rules grammar)}))
+


move (constrain-vals-if)s to (default)s

move (constrain-vals-if)s to (default)s

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -112,18 +112,39 @@
                  :propernoun false
                  :subcat {:1 {:cat :det}
                           :2 '()}}})
-
+
+      (default ;; how a determiner modifies its head noun's semantics.
+       (let [def (atom :top)]
+         {:synsem {:cat :noun
+                   :pronoun false
+                   :propernoun false
+                   :sem {:spec {:def def}}
+                   :subcat {:1 {:def def}}}}))
+
       (default;; a pronoun takes no args.
        {:synsem {:cat :noun
                  :pronoun true
                  :propernoun false
                  :subcat '()}})
+
       (default ;; a propernoun takes no args.
        {:synsem {:cat :noun
                  :pronoun false
                  :propernoun true
                  :subcat '()}})

+      ;; reflexive pronouns: set sharing within :italiano so that morphology can work as expected.
+      (default
+       (let [cat (atom :noun)
+             case (atom :acc)]
+         {:synsem {:cat cat
+                   :pronoun true
+                   :reflexive true
+                   :subcat '()
+                   :case case}
+          :italiano {:cat cat
+                     :case case}}))
+
       (default ;; a verb defaults to intransitive.
        {:synsem {:cat :verb
                  :subcat {:1 {:top :top}
@@ -157,6 +178,12 @@
                    :subcat {:2 {:sem object-semantics}}
                    :sem {:obj object-semantics}}}))

+      (default ;;  a preposition's first argument defaults to the semantic object of preposition.
+       (let [object-semantics (atom :top)]
+         {:synsem {:cat :prep
+                   :subcat {:1 {:sem object-semantics}}
+                   :sem {:obj object-semantics}}}))
+
       (default ;; a verb agrees with its first argument
        (let [subject-agreement (atom :top)]
          {:synsem {:cat :verb
@@ -181,37 +208,20 @@
       (default ;; aux defaults to false.
        {:synsem {:cat :verb
                  :aux false}})
-
-      ;; TODO: replace with (default)
-      (constrain-vals-if
-      (fn [val]
-        (and (= :noun (get-in val [:synsem :cat]))
-             (= true (get-in val [:synsem :reflexive]))
-             (= true (get-in val [:synsem :pronoun]))))
-      (fn [val]
-        (unify (let [case (atom :acc)
-                     cat (atom :noun)]
-                 {:synsem {:cat cat
-                           :pronoun true
-                           :subcat '()
-                           :reflexive true
-                           :case case}
-                  :italiano {:cat cat
-                             :case case}}))))
-
-      ;; TODO: replace with (default)
-      (constrain-vals-if
-      (fn [val]
-        (and (= (get-in val [:synsem :cat]) :noun)
-             (or (= (get-in val [:synsem :agr :gender]) :masc)
-                 (= (get-in val [:synsem :agr :gender]) :fem))
-             (= false (get-in val [:synsem :propernoun] false))
-             (= false (get-in val [:synsem :pronoun] false))
-             (not (= '() (get-in val [:synsem :subcat] :top)))))
-      ;; some nouns e.g. "casa" may have a sense that requires no determiner (subcat = '())
-      ;; in such cases, don't apply agreement-noun.
-      (fn [val]
-        (unify val agreement-noun)))
+
+      (default ;; noun agreement
+       (unify {:synsem {:cat :noun
+                        :pronoun false
+                        :propernoun false
+                        :subcat {:1 {:cat :det}
+                                 :2 '()}}}
+              (let [agr (atom :top)
+                    cat (atom :top)]
+                {:italiano {:agr agr
+                            :cat cat}
+                 :synsem {:cat cat
+                          :agr agr
+                          :subcat {:agr agr}}})))

       phonize2 ;; for each value v of each key k, set the [:italiano :italiano] of v to k, if not already set
       ;; e.g. by exception-generator2.


cleanup

cleanup

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -2272,10 +2272,3 @@
                       "a la prossima"

                       true k)))))
-
-
-
-
-
-
-


make enhanced-version work with strings

make enhanced-version work with strings

--- src/brainbot/nozzle/version.clj
+++ src/brainbot/nozzle/version.clj
@@ -4,14 +4,20 @@

 (defn enhanced-version
   "return version string with git revision appended if it's a snapshot"
-  [group artifact]
-  (if-let [props (v/map-from-property-filepath
-                  (v/get-properties-filename group artifact))]
-    (let [version (get props "version")]
-      (if (re-find #"SNAPSHOT" version)
-        (str version "-" (subs (props "revision") 0 6))
-        version))
-    (System/getProperty (str artifact ".version"))))
+  ([group artifact]
+     (if-let [props (v/map-from-property-filepath
+                     (v/get-properties-filename group artifact))]
+       (let [version (get props "version")]
+         (if (re-find #"SNAPSHOT" version)
+           (str version "-" (subs (props "revision") 0 6))
+           version))
+       (System/getProperty (str artifact ".version"))))
+  ([s]
+     (let [[group artifact] (clojure.string/split s #"/" 2)]
+       (if artifact
+         (enhanced-version group artifact)
+         (enhanced-version group group)))))  ;; some project do that! e.g. clj-time
+

 (defn nozzle-version


Correct docstring typo

Correct docstring typo

--- src/io/aviso/rook/server.clj
+++ src/io/aviso/rook/server.clj
@@ -5,7 +5,7 @@
     [clojure.tools.logging :as l]))

 (defn reloading-handler
-  "Wraps a handler creator function such that the root handler is create fresh on each request;
+  "Wraps a handler creator function such that the root handler is created fresh on each request;
   this is used when developing the application as it supports re-loading of code in a REPL."
   [creator]
   (fn [request]


Parent support in pom task. Don't ask. =\

--- src/leiningen/util/maven.clj
+++ src/leiningen/util/maven.clj
@@ -119,6 +119,14 @@
       nil)))

 ;; model
+
+(defn make-parent [parent version & {:as opts}]
+  (doto (Parent.)
+    (.setArtifactId (name parent))
+    (.setGroupId (or (namespace parent) (name parent)))
+    (.setVersion version)
+    (.setRelativePath (:relative-path opts))
+    (.setModelEncoding (:model-encoding opts))))

 (defn make-exclusion [excl]
   (doto (Exclusion.)
@@ -211,6 +219,8 @@
       (.addRepository model (make-repository repo)))
     (when-let [scm (make-git-scm (file (:root project) ".git"))]
       (.setScm model scm))
+    (when-let [parent (:parent project)]
+      (.setParent model (apply make-parent parent)))
     (doseq [license (concat (keep #(% project)
                                   [:licence :license])
                             (:licences project)


remember to validate body-id = req-id

remember to validate body-id = req-id

--- src/clj/foosball/routes/api.clj
+++ src/clj/foosball/routes/api.clj
@@ -169,7 +169,7 @@
            (let [data    (::data ctx)
                  data-id (:id data)
                  req-id  (::id ctx)]
-             ;(assert (= req-id data-id))
+             (assert (= req-id data-id))
              (assert (not= nil data))
              (d/create-match! db data)
              :ok)))


change route  root /

change route  root /

--- src/clj/introclojure/server.clj
+++ src/clj/introclojure/server.clj
@@ -28,7 +28,8 @@

   (POST "/exercice-eval" [data]
         (-> data (json/read-str :key-fn keyword) introclojure.exercice/eval-exercice json/write-str))
-  (GET "/" [] (introclojure.parser/all))
+  #_(GET "/" [] (introclojure.parser/all))
+  (GET "/" [] (introclojure.parser/do-things))
   (GET "/do-things" [] (introclojure.parser/do-things))

   #_ (GET "/*" req (page)))


refactor routes

refactor routes

--- src/clj/salava/badge/routes.clj
+++ src/clj/salava/badge/routes.clj
@@ -324,15 +324,15 @@
                      :current-user current-user
                      (ok (e/delete! ctx user-badge-id endorsement-id (:id current-user) ))
                      )
-             (POST "/endorsement/update_status/:user-badge-id/:endorsement-id" []
-                   :return {:status (s/enum "success" "error")}
-                   :path-params [user-badge-id :- Long
-                                 endorsement-id :- Long]
-                   :body-params [status :- (s/enum "accepted" "declined")]
+             (POST "/endorsement/update_status/:endorsement-id" []
+                   :return {:status (s/enum "success" "error")}
+                   :path-params [endorsement-id :- Long]
+                   :body-params [status :- (s/enum "accepted" "declined")
+                                 user_badge_id :- s/Int]
                    :summary "Update endorsement status"
                    :auth-rules access/authenticated
                    :current-user current-user
-                   (ok (e/update-status! ctx (:id current-user) user-badge-id endorsement-id status))
+                   (ok (e/update-status! ctx (:id current-user) user_badge_id endorsement-id status))
                    )

              (GET "/user/pending_endorsement" []


Remove stub fn.

Remove stub fn.

--- src/cljc/leipzig_live/util.cljc
+++ src/cljc/leipzig_live/util.cljc
@@ -1,6 +1 @@
 (ns leipzig-live.util)
-
-(defn foo-cljx [x]
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))


Fix player cell descriptions

Fix player cell descriptions

--- src/cljc/robinson/describe.cljc
+++ src/cljc/robinson/describe.cljc
@@ -90,7 +90,7 @@
         npc  (npc-at-xy state x y)
         items (get cell :items)]
     (cond
-      (not= (get cell :discovered) (rw/get-time state))
+      (not= (get cell :discovered) (dec (rw/get-time state)))
         (format "You can't see that.")
       (and npc (seq items))
         (format "There is %s, and %s." (describe-npc npc) (describe-items items))
@@ -108,8 +108,10 @@
 (defn search
   "Describe the player's cell."
   [state]
-  (let [xy (player-xy state)]
-    (append-log state (format "Here %s." (apply describe-cell-at-xy state xy)))))
+  (let [xy (player-xy state)
+        description (apply describe-cell-at-xy state xy)]
+    (append-log state (format "Here %s%s" (clojure.string/lower-case (first description))
+                                           (apply str (rest description))))))

 (defn extended-search
   "Search the Moore neighborhood for hidden things and make them visible. Describe interesting items in the log."


Fixed depth of history and input

Fixed depth of history and input

--- src/cljs/cljs_webrepl/core.cljs
+++ src/cljs/cljs_webrepl/core.cljs
@@ -269,9 +269,9 @@
             "GitHub"]
            [:li.mdl-menu__item
             {:on-click show-about-dialog}
-            "About"]]]]]
-       [history props]
-       [input props]]]]))
+            "About"]]]]
+        [history props]
+        [input props]]]]]))

 (defn mount-root []
   (r/render [home-page] (.getElementById js/document "app")))


make parsets responsive to card width

make parsets responsive to card width

--- src/cljs/searchbot/parsets.cljs
+++ src/cljs/searchbot/parsets.cljs
@@ -28,7 +28,7 @@
 (defn- new-svg [graph-id w h]
   (-> js/d3 (.select graph-id) (.append "svg") (.attr "width" w) (.attr "height" h)))

-(defcomponent parsets [cursor owner {:keys [agg url width height] :or {width 1000 height 600} :as opts}]
+(defcomponent parsets [cursor owner {:keys [agg url height] :or {height 600} :as opts}]
   (init-state [_]
               {:continue? true
                :comm (chan)
@@ -52,19 +52,23 @@
            [:.card
             [:.card-content
              [:span.card-title.black-text "# PARSETS"]
-             [:div {:id "parsets"}]]]))
+             [:div#parsets {:ref "parsets-div"}]]]))
   (did-mount [_]
              (let [{:keys [comm parsets-agg]} (om/get-state owner)
-                   svg (new-svg "#parsets" width height)
+                   card-width (->> "parsets-div" (om/get-node owner) (.-offsetWidth))
+                   get-svg #(new-svg "#parsets" card-width height)
+                   svg (get-svg)
                    chart (-> js/d3
-                              .parsets
-                              (.dimensions (clj->js (map name parsets-agg)))
-                              (.value (fn [d i] (. d -value))))]
+                             .parsets
+                             (.width card-width)
+                             (.height height)
+                             (.dimensions (clj->js (map name parsets-agg)))
+                             (.value (fn [d i] (. d -value))))]
                (om/update-state! owner #(assoc % :svg svg))
                (go (while (:continue? (om/get-state owner))
                      (let [parsets-data (<! comm)
                            _ (-> js/d3 (.select "#parsets > svg") .remove)
-                           svg (new-svg "#parsets" width height)]
+                           svg (get-svg)]
                        (.log js/console "# parsets aggregation:" (count parsets-data))
                        (-> svg (.datum (clj->js parsets-data))
                            (.call chart))


fix parsets using default filter

fix parsets using default filter

--- src/cljs/searchbot/parsets.cljs
+++ src/cljs/searchbot/parsets.cljs
@@ -73,7 +73,7 @@
                :get-agg-terms #(:parsets-agg (om/get-state owner))
                :make-agg-query #(->query {:agg-terms ((:get-agg-terms (om/get-state owner)))
                                           :sub-aggs (:sub agg)
-                                          :default-filter (get-in (:es-settings (om/get-shared owner)) [:default :filter])})
+                                          :default-filter (get-in ((:es-settings (om/get-shared owner))) [:default :filter])})
                :value-path (apply vector (map keyword value-path))
                :svg nil})
   (will-mount [_]


Fix copyright year on hmac ns.

Fix copyright year on hmac ns.

--- src/clojure/buddy/core/hmac.clj
+++ src/clojure/buddy/core/hmac.clj
@@ -1,4 +1,4 @@
-;; Copyright 2013 Andrey Antukh <niwi@niwi.be>
+;; Copyright 2014 Andrey Antukh <niwi@niwi.be>
 ;;
 ;; Licensed under the Apache License, Version 2.0 (the "License")
 ;; you may not use this file except in compliance with the License.


added :web-view

added :web-view

--- src/clojure/neko/ui/mapping.clj
+++ src/clojure/neko/ui/mapping.clj
@@ -60,6 +60,8 @@
                  :traits [:image]
                  :value-namespaces
                  {:scale-type android.widget.ImageView$ScaleType}}
+    :web-view {:classname android.webkit.WebView
+               :inherits :view}

     ;; Other
     :layout-params {:classname ViewGroup$LayoutParams


add safer print settings

add safer print settings

--- user.clj
+++ user.clj
@@ -22,4 +22,7 @@
 ;     (symbol (str '~nsname "/" v#))))
 ;  )

+(set! clojure.core/*print-length* 100)
+(set! clojure.core/*print-level* 5)
+
 (println "Loaded user.clj!")


CMR-1772: Fixed a typo

CMR-1772: Fixed a typo

--- system-int-test/test/cmr/system_int_test/virtual_product_test.clj
+++ system-int-test/test/cmr/system_int_test/virtual_product_test.clj
@@ -198,7 +198,7 @@
   (apply = true (map #(:deleted (ingest/get-concept % revision-id)) concept-ids)))

 ;; Verify that latest revision ids of virtual granules and the corresponding source granules
-;; are in sync as various ingest operoations are performed on the source granules
+;; are in sync as various ingest operations are performed on the source granules
 (deftest revision-ids-in-sync-test
   (let [ast-coll (d/ingest "LPDAAC_ECS"
                            (dc/collection
@@ -210,13 +210,13 @@
         _ (index/wait-until-indexed)
         vp-granule-ids (virtual-granules-attrs vp-colls :id)]

-    ;; check revision ids are synced after ingest/update operations
+    ;; check revision ids are in sync after ingest/update operations
     (is (apply = 5 (virtual-granules-attrs vp-colls :revision-id)))
     (d/ingest "LPDAAC_ECS" (assoc ast-l1a-gran :revision-id 10))
     (index/wait-until-indexed)
     (is (apply = 10 (virtual-granules-attrs vp-colls :revision-id)))

-    ;; check revision ids are synced after delete operations
+    ;; check revision ids are in sync after delete operations
     (ingest/delete-concept (d/item->concept ingest-result) {:revision-id 12})
     (index/wait-until-indexed)
     (is (assert-tombstones vp-granule-ids 12))


(SERVER-1103) Add some jruby pool init waits to jruby service tests

This commit adds some `wait-for-jrubies` calls to some of the
jruby_puppet_server_tests in order to ensure that jruby pool
initialization has terminated before each test finishes, and therefore
helps prevent problems that could be due to overlapping initializations
that could otherwise unintentionally happen as subsequent tests are run.

--- test/unit/puppetlabs/services/jruby/jruby_puppet_service_test.clj
+++ test/unit/puppetlabs/services/jruby/jruby_puppet_service_test.clj
@@ -38,13 +38,6 @@
   [jruby-puppet-pooled-service
    profiler/puppet-profiler-service])

-; This test will occasionally display a stacktrace. This may be due to
-; with-test-logging losing one of the threads. The stack trace looks like this:
-;
-; 2016-01-07 16:40:10,219 ERROR [clojure-agent-send-pool-4] [p.t.internal] shutdown-on-error triggered because of exception!
-; java.lang.IllegalStateException: Attempting to flush a pool that does not appear to have successfully initialized. Aborting.
-;
-; Don't worry, everything is fine.
 (deftest test-error-during-init
   (testing
    (str "If there is an exception while putting a JRubyPuppet instance in "
@@ -218,6 +211,14 @@
       app
       default-services
       (jruby-service-test-config 1)
+      ;; This test doesn't technically need to wait for jruby pool
+      ;; initialization to be done but if it doesn't, the pool initialization
+      ;; may continue on during the execution of a subsequent test and
+      ;; interfere with the next test's results.  This wait ensures that the
+      ;; pool initialization agent will be dormant by the time this test
+      ;; finishes.  It should be possible to remove this when SERVER-1087 is
+      ;; resolved.
+      (jruby-testutils/wait-for-jrubies app)
       (let [service (app/get-service app :JRubyPuppetService)
             context (services/service-context service)]
         (is (= (:borrow-timeout context) jruby-core/default-borrow-timeout))))))
@@ -230,6 +231,14 @@
         app
         default-services
         (jruby-service-test-config-with-timeouts connect-timeout socket-timeout)
+        ;; This test doesn't technically need to wait for jruby pool
+        ;; initialization to be done but if it doesn't, the pool initialization
+        ;; may continue on during the execution of a subsequent test and
+        ;; interfere with the next test's results.  This wait ensures that the
+        ;; pool initialization agent will be dormant by the time this test
+        ;; finishes.  It should be possible to remove this when SERVER-1087 is
+        ;; resolved.
+        (jruby-testutils/wait-for-jrubies app)
         (let [service          (app/get-service app :JRubyPuppetService)
               context          (services/service-context service)
               pool-context-cfg (get-in context [:pool-context :config])]
@@ -241,6 +250,14 @@
       app
       default-services
       (jruby-service-test-config 1)
+      ;; This test doesn't technically need to wait for jruby pool
+      ;; initialization to be done but if it doesn't, the pool initialization
+      ;; may continue on during the execution of a subsequent test and
+      ;; interfere with the next test's results.  This wait ensures that the
+      ;; pool initialization agent will be dormant by the time this test
+      ;; finishes.  It should be possible to remove this when SERVER-1087 is
+      ;; resolved.
+      (jruby-testutils/wait-for-jrubies app)
       (let [service          (app/get-service app :JRubyPuppetService)
             context          (services/service-context service)
             pool-context-cfg (get-in context [:pool-context :config])]
@@ -259,10 +276,18 @@
       (fs/touch facter-jar)
       (bootstrap/with-app-with-config
         app
-        [jruby-puppet-pooled-service profiler/puppet-profiler-service]
+        default-services
         (assoc-in (jruby-service-test-config 1)
           [:jruby-puppet :ruby-load-path]
           (into [] (cons (fs/absolute-path temp-dir)
                      jruby-testutils/ruby-load-path)))
+        ;; This test doesn't technically need to wait for jruby pool
+        ;; initialization to be done but if it doesn't, the pool initialization
+        ;; may continue on during the execution of a subsequent test and
+        ;; interfere with the next test's results.  This wait ensures that the
+        ;; pool initialization agent will be dormant by the time this test
+        ;; finishes.  It should be possible to remove this when SERVER-1087 is
+        ;; resolved.
+        (jruby-testutils/wait-for-jrubies app)
         (is (true? (some #(= facter-jar (.getFile %))
                      (.getURLs (ClassLoader/getSystemClassLoader)))))))))


[#1181] Fix merging of dataset in shared API (with @gabemart)

--- backend/src/akvo/lumen/lib/public_impl.clj
+++ backend/src/akvo/lumen/lib/public_impl.clj
@@ -80,6 +80,7 @@
                       (filter #(= "visualisation" (get % "type")))
                       (map #(get % "id"))
                       (map #(visualisation-response-data tenant-conn % config))
+                      (sort-by #(-> % (get "datasets") vals first (get :rows)))
                       (apply merge-with merge))]
         (assoc deps "dashboards" {id dashboard})))))


Finish test results UI

Finish test results UI

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -659,11 +659,17 @@
                                                  (list
                                                    [:hr]
                                                    [:li
-                                                    [:button.btn-link.build-tests-toggle
-                                                     [:i.fa.fa-chevron-right.build-tests-toggle-icon]
-                                                     "More"]]
-                                                   (om/build-all test-item-v2
-                                                                 (vec other-tests)))))))]]]])
+                                                    [:button.btn-link.build-tests-toggle {:on-click #(om/update-state! owner [:is-open?] not)}
+                                                     (if (om/get-state owner :is-open?)
+                                                       [:span
+                                                        [:i.fa.fa-chevron-up.build-tests-toggle-icon]
+                                                        "Less"]
+                                                       [:span
+                                                        [:i.fa.fa-chevron-down.build-tests-toggle-icon]
+                                                        "More"])]]
+                                                   (when (om/get-state owner :is-open?)
+                                                     (om/build-all test-item-v2
+                                                                   (vec other-tests))))))))]]]])

               (seq tests) [:div
                            "Your build ran "


Add correct action to 'Send Invites' button

--- src-cljs/frontend/components/pages/team.cljs
+++ src-cljs/frontend/components/pages/team.cljs
@@ -138,11 +138,13 @@
                                    "bitbucket" [:i.fa.fa-bitbucket]
                                    nil)])
                    :action  (html
-                                (let [users (remove :circle_member (:github-users (:invite-data app)))
+                                (let [invite-data (:invite-data app)
+                                      users (remove :circle_member (:github-users invite-data))
+                                      opts {:vcs_type (:vcs_type invite-data)
+                                            :org-name (:org invite-data)}
                                       count-users (count users)
                                       count-with-email (count (filter #(utils/valid-email? (:email %)) users))
                                       count-selected (count (filter #(:checked %) users))]
-                                    ;; TODO -ac You can turn all of this vvvvv into an :action for the title of the card!
                                     [:div (when (:invite-teammates? (om/get-render-state owner))
                                               (component
                                                   (modal/modal-dialog {:title "Invite Teammates"
@@ -197,8 +199,11 @@
                                                                        :actions [(button/button {:on-click #(om/set-state! owner :invite-teammates? false)} "Cancel")
                                                                                (forms/managed-button
                                                                                [:button.btn.btn-success {:data-success-text "Sent"
-                                                                                ;; :on-click #(raise! owner [:invited-github-users {:invitees (invitees users)}])
-                                                                                :on-click #(.log js/console "Send the emails in this on-click!" (seq (invitees users)))
+                                                                                :on-click #(raise! owner [:invited-github-users (merge {:invitees (invitees users)
+                                                                                :vcs_type (:vcs_type opts)}
+                                                                                (if (:project-name opts)
+                                                                                {:project-name (:project-name opts)}
+                                                                                {:org-name (:org-name opts)}))])
                                                                                :disabled (or (empty? (invitees users))
                                                                                (not (every? #(utils/valid-email? (:email %)) (invitees users))))}
                                                                                "Send Invites "


remove unnecessary thread

remove unnecessary thread

--- src-cljs/frontend/components/statuspage.cljs
+++ src-cljs/frontend/components/statuspage.cljs
@@ -43,7 +43,7 @@
     (go
      (let [res (<! (ajax/managed-ajax :get page-url))]
        (when (= :success (:status res))
-         (om/set-state! component :statuspage {:summary (->> res :resp)}))))))
+         (om/set-state! component :statuspage {:summary (:resp res)}))))))

 (defn incident-markup [incident]
   (let [status (first (:incident_updates incident))]


Created a named predicate for name validation

--- src/kixi/datastore/metadatastore.clj
+++ src/kixi/datastore/metadatastore.clj
@@ -10,13 +10,18 @@
             [kixi.datastore.schemastore.conformers :as sc]
             [clojure.spec.gen :as gen]))

+(defn valid-file-name?
+  "A file name should be at least one valid character long and only have valid characters and start with a digit or letter."
+  [s]
+  (when (string? s)
+    (re-matches #"^[\p{Digit}\p{IsAlphabetic}].{0,512}$" s)))
+
 (s/def ::type #{"stored" "bundle"})
 (s/def ::file-type sc/not-empty-string)
 (s/def ::id sc/uuid)
 (s/def ::parent-id ::id)
 (s/def ::pieces-count int?)
-(s/def ::name (s/with-gen (s/and sc/not-empty-string
-                                 #(when (string? %) (re-matches #"^[\p{Digit}\p{IsAlphabetic}].{0,512}$" %)))
+(s/def ::name (s/with-gen (s/and sc/not-empty-string valid-file-name?)
                 #(gen/such-that (fn [x] (and (< 0 (count x) 512)
                                              (re-matches #"^[\p{Digit}\p{IsAlphabetic}]" ((comp str first) x)))) (gen/string) 100)))
 (s/def ::description sc/not-empty-string)


Removed spaces when printing implications

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

--- src/conexp/fca/implications.clj
+++ src/conexp/fca/implications.clj
@@ -38,7 +38,7 @@
   (.conclusion impl))

 (defmethod print-method Implication [impl out]
-  (.write out (str "( " (premise impl) "  ==>  " (conclusion impl) " )")))
+  (.write out (str "(" (premise impl) "  ==>  " (conclusion impl) ")")))

 ;;;


added a comment organizing the dissecting ns a bit... considering moving the tabular dissection code into its own ns

--- src/midje/midje_forms/dissecting.clj
+++ src/midje/midje_forms/dissecting.clj
@@ -35,6 +35,9 @@
         (recur (conj so-far whole-body)
                (nthnext remainder (count whole-body)))))))

+;; dissecting tabular facts - could be in its own ns since it uses nothing from the above code
+;; maybe midje.midje-forms.dissecting.tabular
+
 (defn- remove-pipes+where [table]
   (let [strip-off-where #(if (contains? #{:where 'where} (first %)) (rest %) % )]
     (->> table strip-off-where (remove #(= "|" (pr-str %))))))


Add power rule

Add power rule

--- src/main/cljc/clojure_club/x121_universal_computation_engine/mgrimm.cljc
+++ src/main/cljc/clojure_club/x121_universal_computation_engine/mgrimm.cljc
@@ -7,28 +7,30 @@
     (let [[op u v] e
           u' (f' u dvar) v' (f' v dvar)]
       (case op
-        + (list '+ u' v')
-        - (list '- u' v')
-        * (list '+ (list '* u v') (list '* v u'))
-        / (list '/ (list '- (list '* v u') (list '* u v')) (list '* v v))))
+        +   (list '+ u' v')
+        -   (list '- u' v')
+        *   (list '+ (list '* u v') (list '* v u'))
+        /   (list '/ (list '- (list '* v u') (list '* u v')) (list '* v v))
+        **  (list '* v (list '** u (dec v)))))
     (number? e) 0
     (and (symbol? e) (= e dvar)) 1
     :else 0))

 (defn calc [formula]
   (fn [smap]
-    (->> formula
-         (walk/prewalk
-           (fn [x]
-             (cond-> x
-               (and (list? x) (#{'f'} (first x)))
-               (->> rest (apply f')))))
-         (walk/postwalk
-           (fn [x]
-             (if (list? x)
-               (let [[op & os] (replace (merge smap {'/ / '* * '+ + '- -}) x)]
-                 (apply op os))
-               x))))))
+    (let [smap (merge smap {'/ / '* * '+ + '- - '** #(Math/pow %1 %2)})]
+      (->> formula
+           (walk/prewalk
+             (fn [x]
+               (cond-> x
+                 (and (list? x) (#{'f'} (first x)))
+                 (->> rest (apply f')))))
+           (walk/postwalk
+             (fn [x]
+               (if (list? x)
+                 (let [[op & os] (replace smap x)]
+                   (apply op os))
+                 x)))))))

 ;; -----------------------------------------------------------------------------

@@ -49,10 +51,12 @@
                         (* 3 (+ y 1))))
               '{x 4 y 1})))

-(assert (= 0 ((calc '(f' 2 x)) nil)))
-(assert (= 1 ((calc '(f' x x)) nil)))
+(assert (= 0 ((calc '(f' 2 x)) nil))) ; constant
+(assert (= 1 ((calc '(f' x x)) nil))) ; line
 (assert (= 0 ((calc '(f' y x)) nil)))
-(assert (= 3 ((calc '(f' (* x y) x)) '{x -1 y 3})))
-(assert (= 10 ((calc '(f' (* x x) x)) '{x 5})))
+(assert (= 3 ((calc '(f' (* x y) x)) '{x -1 y 3}))) ; product
+(assert (= 10 ((calc '(f' (* x x) x)) '{x 5})))
 (assert (= 40 ((calc '(f' (+ (* x x) (* 3 y)) x)) '{x 20 y -1})))
-(assert (= 1/8 ((calc '(f' (/ x (* 2 y)) x)) '{x -1 y 4})))
+(assert (= 1/8 ((calc '(f' (/ x (* 2 y)) x)) '{x -1 y 4}))) ; quotient
+(assert (= 6.0 ((calc '(f' (** x 2) x)) '{x 3}))) ; power
+(assert (= -1/4 ((calc '(f' (/ 1 x) x)) '{x 2}))) ; reciprocal


in entity importer, pin the add icon to always be visible (#1290)

--- src/cljs/main/broadfcui/page/workspace/data/entity_selector.cljs
+++ src/cljs/main/broadfcui/page/workspace/data/entity_selector.cljs
@@ -70,7 +70,8 @@
                             {:data (data source?)
                              :body {:empty-message ((if source? :left-empty-text :right-empty-text) props)
                                     :style table-style/table-heavy
-                                    :columns (columns source?)}
+                                    :columns (columns source?)
+                                    :behavior {:fixed-column-count 1}}
                              :toolbar
                              {:style {:flexWrap "wrap"}
                               :get-items


(SERVER-1315) Update autosigning test description

--- test/unit/puppetlabs/puppetserver/certificate_authority_test.clj
+++ test/unit/puppetlabs/puppetserver/certificate_authority_test.clj
@@ -436,7 +436,7 @@
         (is (nil? (.verify cert capub)))))))

 (deftest autosign-with-bundled-ca-certs
-  (testing "The CA public key file can be a bundle of certs"
+  (testing "The CA certificate file can be a bundle of certs"
     (let [settings  (testutils/ca-sandbox! bundle-cadir)
           csr       (-> (:csrdir settings)
                         (path-to-cert-request "test-agent")


Fix busy sleep foo.

Fix busy sleep foo.

--- src/dsbdp/experiment_helper.clj
+++ src/dsbdp/experiment_helper.clj
@@ -91,8 +91,8 @@
 (defn create-busy-sleep-proc-fns
   [n]
   (create-proc-fns
-    '(fn [i _] (dsbdp.ExperimentHelper/busySleep (i :_idx_)))
-    '(fn [i _] (dsbdp.ExperimentHelper/busySleep (i :_idx_)))
+    '(fn [i _] (dsbdp.ExperimentHelper/busySleep ^long (i :_idx_)) 0)
+    '(fn [i _] (dsbdp.ExperimentHelper/busySleep ^long (i :_idx_)) 0)
      n))

 (def sample-pcap-processing-definition-rules


Document fhofherr.simple.project.

Document fhofherr.simple.project.

--- src/fhofherr/simple/project.clj
+++ src/fhofherr/simple/project.clj
@@ -1,14 +1,42 @@
 (ns fhofherr.simple.project
+  "Functions and macros required to define a Simple CI project in a `simple.clj`
+  project definition file. All public functions in this namespace are available
+  from within the `simple.clj` project definition file."
   (:require [clojure.java.shell :refer [sh]]))

-(defn execute
-  [executable]
-  (fn [job-context]
-    (sh (str (:project-dir job-context) "/" executable))))
+(defmacro defjob
+  "Define a Simple CI job. In its most basic form a Simple CI job has a name
+  and a test command, e.g.:

-(defmacro defjob
+  ```clojure
+  (defjob some-job-name
+    :test test-command)
+  ```
+
+  Test commands are functions that expect a `job-context` map as their only
+  argument.
+
+  Just a test commands Simple CI jobs themselfes are functions. They too expect
+  a `job-context` as their only argument which they pass on to their test
+  command.
+
+  Simple CI jobs have the key `:ci-job?` with the value `true` in their meta
+  data.
+
+  TODO: currently the job commands return value is left unspecified. It might
+        be wise to expect job commands to return a (possibly altered)
+        job-context."
   [job-name & {:keys [test]}]
   `(defn ~(vary-meta job-name assoc :ci-job? true)
      [job-context#]
      (when ~test
        (~test job-context#))))
+
+(defn execute
+  "Create a test command that executes the given executable using
+  `clojure.java.shell/sh`.
+
+  Returns whatever `clojure.java.shell/sh` returns."
+  [executable]
+  (fn [job-context]
+    (sh (str (:project-dir job-context) "/" executable))))


Use generic error handler

Use generic error handler

--- frontend/src/cruncher/communication/favorites.cljs
+++ frontend/src/cruncher/communication/favorites.cljs
@@ -12,10 +12,6 @@
           new-col (update-in (vec (get-in @lib/app-state [:pokemon])) [index :favorite] (constantly (:set_favorite res)))]
       (lib/update-pokemon! new-col))))

-(defn error-handler [response]
-  (let [res (com/process-response response)]
-    (lib/error! (:message res))))
-
 (defn post-favorite
   "Get cleaned data and send ajax request."
   [id favorite]
@@ -25,7 +21,7 @@
           {:body            (clib/clj->json {:id id
                                              :set_favorite favorite})
            :handler         success-handler
-           :error-handler   error-handler
+           :error-handler   com/error-handler
            :response-format :json
            :headers         {"Content-Type" "application/json"}
            :keywords?       true})))


Deleted broken tests.

Deleted broken tests.

--- app/test/weather/weather_api_test.clj
+++ app/test/weather/weather_api_test.clj
@@ -1,15 +0,0 @@
-(ns weather.weather-api-test
-  (:require [clojure.test :refer :all]
-            [weather.test-utils :as test-utils]
-            [monger.collection :as mc]
-            [weather.weather-api :refer :all]))
-
-(use-fixtures :each test-utils/database-fixture)
-
-(def url "http://localhost:8181/api/weather")
-
-(def database (get-in test-utils/test-system [:mongodb :database]))
-
-(deftest weather-api-test
-  (testing "TODO Write tests!"
-   (is (= 1 1))))


Finished improving integration test

Finished improving integration test

--- test/clojure_rest/integration/controllers/document_controller_test.clj
+++ test/clojure_rest/integration/controllers/document_controller_test.clj
@@ -8,6 +8,8 @@

 (def expectedHeaders {"Content-Type" "application/json; charset=utf-8"})
 (def initialDocumentList (json/generate-string [{:id_document "1" :title "titre1" :text "text1"} {:id_document "2" :title "titre2" :text "text2"}]))
+(def documentToCreate {:id_document "dummy" :title "newDocumentTitle" :text "newDocumentText"})
+(def documentToUpdate {:id_document "1" :title "titre1Updated" :text "texte1Updated"})

 (deftest test-document-controller-list
   (database/initDatabase)
@@ -32,47 +34,46 @@
   (database/initDatabase)

   (testing "Testing document creation route worked"
-    (let [request (mock/request :post "/documents" (json/generate-string {:id_document "dummy" :title "newDocumentTitle" :text "newDocumentText"}))]
+    (let [request (mock/request :post "/documents" (json/generate-string documentToCreate))]
     (let [response (app (mock/content-type request "application/json"))]
-      (is (= (:status response) 200)))))
-  ; TODO Add body test and count test
+      (is (= (:status response) 200))
+      (is (= (get (json/parse-string (:body response)) "title") (:title documentToCreate)))
+      (is (= (get (json/parse-string (:body response)) "text") (:text documentToCreate)))
+      (is (= (count (jdbc/query database/db-h2-connection ["select * from documents"])) 3)))))

   (testing "Testing document creation route failed because of incorrect document"
     (let [request (mock/request :post "/documents" (json/generate-string {:id_document "dummy" :title "newDocumentTitle" :text "newDocumentText" :wrongattribute "badvalue"}))]
     (let [response (app (mock/content-type request "application/json"))]
-      (is (= (:status response) 400)))))) ; FIXME This test causes an error
+      (is (= (:status response) 400))))))

 (deftest test-document-controller-update
   (database/initDatabase)

   (testing "Testing document update route worked"
-    (let [request (mock/request :put "/documents/1" (json/generate-string {:id_document "1" :title "titre1Updated" :text "texte1Updated"}))]
+    (let [request (mock/request :put "/documents/1" (json/generate-string documentToUpdate))]
       (let [response (app (mock/content-type request "application/json"))]
-      (is (= (:status response) 200)))))
-  ; TODO Add tests on body returned and database
+      (is (= (:status response) 200))
+      (is (= (get (json/parse-string (:body response)) "title") (:title documentToUpdate)))
+      (is (= (get (json/parse-string (:body response)) "text") (:text documentToUpdate))))))

   (testing "Testing document update route failed with incorrect id"
     (let [request (mock/request :put "/documents/notfound" (json/generate-string {:id_document "noid" :title "wontwork" :text "causeIncorrectid"}))]
       (let [response (app (mock/content-type request "application/json"))]
       (is (= (:status response) 404)))))
-  ; TODO Add tests on body returned and database

   (testing "Testing document update route failed with incorrect document format"
     (let [request (mock/request :put "/documents/invalidformat" (json/generate-string {:id_document "incorrectformat" :title "wontwork"}))]
       (let [response (app (mock/content-type request "application/json"))]
-      (is (= (:status response) 400)))))
-  ; TODO Add tests on body returned and database
-  )
+      (is (= (:status response) 400))))))

 (deftest test-document-controller-delete
   (database/initDatabase)
-
   (testing "Testing document delete route worked"
     (let [response (app (mock/request :delete "/documents/1"))]
-      (is (= (:status response) 204))))
-  ; TODO Add tests on database
+      (is (= (:status response) 204))
+      (is (= (count (jdbc/query database/db-h2-connection ["select * from documents"])) 1))))

+  (database/initDatabase)
   (testing "Testing document delete route failed"
     (let [response (app (mock/request :delete "/documents/notfound"))]
-      (is (= (:status response) 404))))) ; FIXME This test fails
-; TODO Add tests on database and correct error
+      (is (= (:status response) 404)))))


refactor test for reuse - no functional changes

--- test/puppetlabs/master/services/ca/certificate_authority_core_test.clj
+++ test/puppetlabs/master/services/ca/certificate_authority_core_test.clj
@@ -10,6 +10,28 @@

 (use-fixtures :once schema-test/validate-schemas)

+
+(def cadir "./dev-resources/config/master/conf/ssl/ca")
+(def csrdir (str cadir "/requests"))
+(def signeddir (str cadir "/signed"))
+
+
+(def settings
+  {:allow-duplicate-certs true
+   :autosign              true
+   :ca-name               "some CA"
+   :cacert                (str cadir "/ca_crt.pem")
+   :cacrl                 (str cadir "/ca_crl.pem")
+   :cakey                 (str cadir "/ca_key.pem")
+   :capub                 (str cadir "/ca_pub.pem")
+   :signeddir             signeddir
+   :csrdir                csrdir
+   :ca-ttl                100
+   :serial                (doto (str (ks/temp-file))
+                            (ca/initialize-serial-file!))
+   :cert-inventory        (str (ks/temp-file))
+   :load-path             ["ruby/puppet/lib" "ruby/facter/lib"]})
+
 (deftest crl-endpoint-test
   (testing "implementation of the CRL endpoint"
     (let [response (handle-get-certificate-revocation-list
@@ -20,25 +42,7 @@
       (is (string? (:body response))))))

 (deftest handle-put-certificate-request!-test
-  (let [cadir     "./dev-resources/config/master/conf/ssl/ca"
-        signeddir (str cadir "/signed")
-        csrdir    (str cadir "/requests")
-        settings  {:allow-duplicate-certs true
-                   :autosign              true
-                   :ca-name               "some CA"
-                   :cacert                (str cadir "/ca_crt.pem")
-                   :cacrl                 (str cadir "/ca_crl.pem")
-                   :cakey                 (str cadir "/ca_key.pem")
-                   :capub                 (str cadir "/ca_pub.pem")
-                   :signeddir             signeddir
-                   :csrdir                csrdir
-                   :ca-ttl                100
-                   :serial                (doto (str (ks/temp-file))
-                                            (ca/initialize-serial-file!))
-                   :cert-inventory        (str (ks/temp-file))
-                   :load-path             ["ruby/puppet/lib" "ruby/facter/lib"]}
-        csr-path  (ca/path-to-cert-request csrdir "test-agent")]
-
+  (let [csr-path  (ca/path-to-cert-request csrdir "test-agent")]
     (testing "when autosign results in true"
       (doseq [value [true
                      "dev-resources/config/master/conf/ruby-autosign-executable"


Better low CPU usage idle strategy

Better low CPU usage idle strategy

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -79,8 +79,8 @@
                                                10
                                                (.toNanos TimeUnit/MICROSECONDS 1)
                                                (.toNanos TimeUnit/MICROSECONDS 100))
-    :high-restart-latency (BackoffIdleStrategy. 100
-                                                10
+    :high-restart-latency (BackoffIdleStrategy. 10
+                                                100
                                                 (.toNanos TimeUnit/MICROSECONDS 10000)
                                                 (.toNanos TimeUnit/MICROSECONDS 100000))))


add main-synth-group

add main-synth-group

--- src/overtone/studio/core.clj
+++ src/overtone/studio/core.clj
@@ -38,3 +38,7 @@
   (ensure-connected!)
   (:input-group @studio*))

+(defn main-synth-group
+  []
+  (ensure-connected!)
+  (:synth-group @studio*))


Mark as-url-or-file private

Mark as-url-or-file private

Didn't intend it to be public

--- planck-cljs/src/planck/io.cljs
+++ planck-cljs/src/planck/io.cljs
@@ -35,7 +35,7 @@
   (as-file [f] f)
   (as-url [f] (build-uri :file nil nil (:path f) nil)))

-(defn as-url-or-file [f]
+(defn- as-url-or-file [f]
   (if (.startsWith f "http")
     (as-url f)
     (as-file f)))


fix spelling

fix spelling

--- src/overtone/sc/machinery/ugen/metadata/noise.clj
+++ src/overtone/sc/machinery/ugen/metadata/noise.clj
@@ -69,7 +69,7 @@
       {:name "LFNoise2"
        :args [{:name "freq", :default 500.0 :doc "approximate rate at which to generate random values."}]
        :rates #{:ar :kr}
-       :doc "Generates quadratically interpolated random values at the suplied rate (the rate is not guaranteed but approximate).
+       :doc "Generates quadratically interpolated random values at the supplied rate (the rate is not guaranteed but approximate).

   Note: quadratic interpolation means that the noise values can occasionally extend beyond the normal range
   of +-1, if the freq varies in certain ways. If this is undesirable then you might like to clip2 the values


Rename keycode function

Rename keycode function

--- src/play_clj/core_global.clj
+++ src/play_clj/core_global.clj
@@ -34,14 +34,14 @@
     :y (.getY ^Input (Gdx/input))
     nil))

-(defmacro get-keycode
+(defmacro keycode
   [key]
   `~(symbol
       (str utils/gdx-package ".Input$Keys/" (utils/key->static-field key))))

 (defmacro is-pressed?
   [key]
-  `(.isKeyPressed ^Input (Gdx/input) (get-keycode ~key)))
+  `(.isKeyPressed ^Input (Gdx/input) (keycode ~key)))

 (defn- input-processor
   [{:keys [on-key-down on-key-typed on-key-up on-mouse-moved


Add loader

Add loader

--- src/play_clj/core_global.clj
+++ src/play_clj/core_global.clj
@@ -124,8 +124,10 @@

 (defn sound*
   "The function version of `sound`"
-  [^String path]
-  (audio! :new-sound (files! :internal path)))
+  [path]
+  (audio! :new-sound (if (string? path)
+                       (files! :internal path)
+                       path)))

 (defmacro sound
   "Returns a [Sound](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/audio/Sound.html)
@@ -143,3 +145,43 @@
   [object k & options]
   `(let [^Sound object# ~object]
      (u/call! object# ~k ~@options)))
+
+(defn ^:private loader-init
+  "Internal use only"
+  [k]
+  (cond
+    (contains? #{:atlas-tmx-map :tmx-map} k)
+    (u/gdx :maps :tiled (str (u/key->pascal k) "Loader."))
+    (contains? #{:g3d-model :obj} k)
+    (u/gdx :graphics :g3d :loader (str (u/key->pascal k) "Loader."))
+    :else
+    (u/gdx :assets :loaders (str (u/key->pascal k) "Loader."))))
+
+(defmacro loader
+  "Returns a subclass of [AsynchronousAssetLoader](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/assets/loaders/AsynchronousAssetLoader.html)
+
+    (loader :atlas-tmx-map \"map.atlas\")
+    (loader :tmx-map \"map.tmx\")
+    (loader :obj \"model.obj\")
+    (loader :g3d-model \"cube.g3dj\")
+    (loader :bitmap-font \"arial.fnt\")
+    (loader :music \"song.ogg\")
+    (loader :pixmap \"background.png\")
+    (loader :skin \"uiskin.json\")
+    (loader :sound \"hit.ogg\")
+    (loader :texture \"monster.png\")"
+  [type path & options]
+  `(let [object# (~(loader-init type) (if (string? ~path)
+                                        (files! :internal ~path)
+                                        ~path))]
+     (u/calls! object# ~@options)))
+
+(defmacro loader!
+  "Calls a static method in a subclass of [AsynchronousAssetLoader](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/assets/loaders/AsynchronousAssetLoader.html)
+
+    (attribute! :color :create-diffuse (color :blue))"
+  [type k & options]
+  `(~(u/gdx-field :graphics :g3d :attributes
+                  (str (u/key->pascal type) "Attribute")
+                  (u/key->camel k))
+     ~@options))


working GET-REPLY

working GET-REPLY

--- src/poky/protocol/custom.clj
+++ src/poky/protocol/custom.clj
@@ -4,7 +4,7 @@
         [aleph.tcp]
         [gloss core io]))

-(def TRM-DATA-BLOCK (string :utf-8 :delimiters "\r\n"))
+(def TRM-DATA-BLOCK (string :utf-8 :suffix "\r\n"))
 (def C (string :utf-8 :delimiters " "))
 (def K (string :utf-8 :delimiters " "))
 (def CR (string :utf-8 :delimiters ["\r\n"]))
@@ -16,8 +16,11 @@
 (defcodec GET ["GET" CR])
 (defcodec GETS ["GETS" CR])
 (defcodec END ["END" CR])
-(defcodec VALUE ["VALUE" CR TRM-DATA-BLOCK])
-(defcodec GET-REPLY ["STORED" CR (repeated VALUE) END])
+(defcodec VALUE [C CR CR])
+
+; to test (decode GET-REPLY gets_test_b)
+(defcodec GET-REPLY (repeated VALUE :prefix :none :delimiters ["END\r\n"]))
+
 ;VALUE <key> <flags> <bytes> [<cas unique>]\r\n
 ;<data block>\r\n
 ;...
@@ -25,7 +28,12 @@

 (defcodec ERRC (string :utf-8))

-;(def store_test_b (java.nio.ByteBuffer/wrap (.getBytes "STORED\r\nVALUE abc\r\n123\r\nEND\r\n")))
+;(def sb (java.nio.ByteBuffer/wrap (.getBytes "STORED\r\nVALUE abc\r\n123\r\n")))
+;(defcodec X ["STORED" CR C CR CR "END" CR])
+;(def get_test_b (java.nio.ByteBuffer/wrap (.getBytes "VALUE abc\r\n123\r\nEND\r\n")))
+;(def gets_test_b (java.nio.ByteBuffer/wrap (.getBytes "VALUE abc\r\n123\r\nVALUE cde\r\n456\r\nEND\r\n")))
+;(def value_test_b (java.nio.ByteBuffer/wrap (.getBytes "VALUE abc\r\n123\r\n")))
+;(def values_test_b (java.nio.ByteBuffer/wrap (.getBytes "VALUE abc\r\n123\r\nVALUE cde\r\n456\r\n")))

 (defcodec CMDS
           (header C


Modernized/stripped down simulation/play a bit

--- src/polismath/simulation.clj
+++ src/polismath/simulation.clj
@@ -109,13 +109,13 @@

 (defn play [& args]
-  (let [big-ptpts    20000
-        big-comments 100
+  (let [big-ptpts    2000
+        big-comments 200
         a (conv-update {:rating-mat (named-matrix)} (random-votes 100 10))
-        a (time2 "CONVUP med" (conv-update a (random-votes 500 10)))
-        a (time2 "CONVUP big" (conv-update a (random-votes big-ptpts big-comments)))]
-    (profile :info :clusters
-      (time2 "CONVUP big-part" (conv-update a (random-votes big-ptpts (+ big-comments 2)) :large-cutoff 10000)))))
+        a (conv-update a (random-votes big-ptpts big-comments) :max-ptpts 1000 :max-cmts 100)]
+    (println "XXX" (:n a) (:n-cmts a))))
+    ;(profile :info :clusters
+      ;(conv-update a (random-votes big-ptpts (+ big-comments 2)) :large-cutoff 10000 :max-ptpts 10000))

 (defn replay-conv-update [filename]


Add page create and update repo methods.

--- src/uxbox/repo/projects.cljs
+++ src/uxbox/repo/projects.cljs
@@ -25,3 +25,17 @@
 (defmethod urc/-do :fetch/pages
   [type data]
   (urc/req! {:url (str urc/+uri+ "/pages") :method :get}))
+
+(defmethod urc/-do :create/page
+  [type {:keys [id] :as data}]
+  (let [params {:url (str urc/+uri+ "/pages")
+                :method :post
+                :body data}]
+    (urc/req! params)))
+
+(defmethod urc/-do :update/page
+  [type {:keys [id] :as data}]
+  (let [params {:url (str urc/+uri+ "/pages/" id)
+                :method :put
+                :body data}]
+    (urc/req! params)))


(PDB-4266) Remove package_inventory key from hash if empty

If the package inventory is empty, we don't store anything in the
database, and it is therefore undifferentiable from a factset that
didn't have a package_inventory submitted with it at all. This would
create a problem when syncing by potentially generating the wrong hash
when we couldn't tell if we were syncing an empty package inventory or a
missing package inventory.

By removing an empty package_inventory key, we generate a hash that is
consistent and reproducible from the data stored in PostgreSQL.

--- src/puppetlabs/puppetdb/scf/hash.clj
+++ src/puppetlabs/puppetdb/scf/hash.clj
@@ -202,6 +202,13 @@
   and producer.
   "
   [fact-data]
-  (-> fact-data
-    (dissoc :timestamp :producer_timestamp :producer)
-    generic-identity-hash))
+  (-> ;; If the :package_inventory is not a seq (ie. empty) in fact-data
+      ;; we remove package-inventory key entirely because an absent
+      ;; and empty package inventory are stored identically so there's no
+      ;; way to tell them apart during sync, and we need the the hashing
+      ;; to be consistent.
+      (if (seq (:package_inventory fact-data))
+        fact-data
+        (dissoc fact-data :package_inventory))
+      (dissoc :timestamp :producer_timestamp :producer)
+      generic-identity-hash))


added ns repl

added ns repl

--- modules/ns.clj
+++ modules/ns.clj
@@ -52,6 +52,12 @@
   [namespace nick]
   "Setting nick ...")

+(defn repl
+  "Launch a repl with given ns"
+  [namespace]
+  (let [fx (fn [] (in-ns (symbol namespace)))]
+    (clojure.main/repl :init fx)))
+
 (defn http
   "Serve the given ns over HTTP. http://host:8000/ns?arg=value&"
   [namespace]


Assign QA QC users to assigned plots

Assign QA QC users to assigned plots

--- src/clj/collect_earth_online/db/projects.clj
+++ src/clj/collect_earth_online/db/projects.clj
@@ -156,11 +156,23 @@
 ;;; Create project
 ;;;

-(defn- add-users-to-plots [user-id users-plots]
-  (map (fn [{:keys [plot_id]}]
-         {:plot_rid plot_id
+(defn- ceil-percent [num percent]
+  (Math/ceil (* num (/ percent 100))))
+
+;; TODO consider returning plot_rid from get_plot_centers_by_project instead of passing in key.
+(defn- add-users-to-plots [user-id users-plots plot-key]
+  (map (fn [old-plot]
+         {:plot_rid (get old-plot plot-key)
           :user_rid user-id})
        users-plots))
+
+(defn- equally-assign-users [plots users plot-key]
+  (->> (partition-all (Math/ceil (/ (count plots) (count users)))
+                      plots)
+       (map (fn [user-id users-plots]
+              (add-users-to-plots user-id users-plots plot-key))
+            users)
+       (apply concat)))

 (defn- assign-user-plots
   "Assigns users to plots. The two assignment options are:
@@ -174,27 +186,42 @@
   (let [{:keys [user-method users percents]} (:user-assignment design-settings)
         plot-count (count plots)]
     (case user-method
-      "equal"   (->> (partition-all (Math/ceil (/ plot-count
-                                                  (count users)))
-                                    plots)
-                     (map (fn [user-id users-plots]
-                            (add-users-to-plots user-id users-plots))
-                          users)
-                     (apply concat))
+      "equal"   (equally-assign-users plots users :plot_id)
       "percent" (loop [rem-users    users
                        rem-percents percents
                        rem-plots    plots
                        user-plots   []]
                   (if (= 1 (count rem-users))
                     (concat user-plots
-                            (add-users-to-plots (first rem-users) rem-plots))
-                    (let [num-plots (Math/ceil (* plot-count (/ (first rem-percents) 100)))]
+                            (add-users-to-plots (first rem-users) rem-plots :plot_id))
+                    (let [num-plots (ceil-percent plot-count (first rem-percents))]
                       (recur (rest rem-users)
                              (rest rem-percents)
                              (drop num-plots rem-plots)
                              (concat user-plots (add-users-to-plots (first rem-users)
-                                                                    (take num-plots rem-plots)))))))
+                                                                    (take num-plots rem-plots)
+                                                                    :plot_id))))))
       nil)))
+
+(defn- assign-qaqc [assigned-plots design-settings]
+  (when (seq assigned-plots)
+    (let [{:keys [qaqc-method percent smes]} (:qaqc-assignment design-settings)
+          {:keys [users]}                    (:user-assignment design-settings)]
+      (concat assigned-plots
+              (->> assigned-plots
+                   (group-by :user_rid)
+                   (map (fn [[user-id user-plots]]
+                          [user-id (take (ceil-percent (count user-plots) percent)
+                                         user-plots)]))
+                   (reduce (fn [acc [user-id user-plots]]
+                             (let [other-users (case qaqc-method
+                                                 "overlap" (remove #(= user-id %) users)
+                                                 "sme"     smes
+                                                 nil)]
+                               (concat acc (equally-assign-users user-plots
+                                                                 other-users
+                                                                 :plot_rid))))
+                           []))))))

 (defn- create-project-samples! [project-id
                                 plot-shape
@@ -233,7 +260,7 @@
                             (str/join ", " (take 10 bad-plots))
                             "]"))))
     (when-let [assigned-plots (assign-user-plots plots design-settings)]
-      (p-insert-rows! "assigned_plots" assigned-plots))))
+      (p-insert-rows! "assigned_plots" (assign-qaqc assigned-plots design-settings)))))

 (defn- create-project-plots! [project-id
                               lon-min
@@ -329,7 +356,12 @@
                                                          :users       [4581 1]}}
                                     #_{:user-assignment {:user-method "percent"
                                                          :users       [4581 5 11]
-                                                         :percents    [50.0 25.0 25.0]}})
+                                                         :percents    [50.0 25.0 25.0]}}
+                                    #_{:qaqc-assignment {:qaqc-method "overlap"
+                                                         :percent     50}}
+                                    #_{:qaqc-assignment {:qaqc-method "sme"
+                                                         :percent     100
+                                                         :smes        [2 5]}})
         project-template     (tc/val->int (:projectTemplate params))
         use-template-plots   (tc/val->bool (:useTemplatePlots params))
         use-template-widgets (tc/val->bool (:useTemplateWidgets params))


Generalize the ack-success event handler and use it for recorded

i.e. the ::recorded-production event

--- src/cljs/mdr2/productions/in_production.cljs
+++ src/cljs/mdr2/productions/in_production.cljs
@@ -49,15 +49,15 @@

 (rf/reg-event-fx
   ::delete-production
-  (fn [{:keys [db]} [_ id]]
-    (let [production (get-in db [:productions :in-production id])]
-      {:db (notifications/set-button-state db id :delete)
+  (fn [{:keys [db]} [_ uuid]]
+    (let [production (get-in db [:productions :in-production uuid])]
+      {:db (notifications/set-button-state db uuid :delete)
        :http-xhrio
        (as-transit {:method          :delete
                     :headers 	     (auth/auth-header db)
                     :uri             (str "/api/productions/" (:id production))
-                    :on-success      [::ack-delete id]
-                    :on-failure      [::ack-failure id :delete]
+                    :on-success      [::ack-success uuid :delete]
+                    :on-failure      [::ack-failure uuid :delete]
                     })})))

 (rf/reg-event-db
@@ -66,11 +66,11 @@
     (notifications/clear-button-state db id :save)))

 (rf/reg-event-fx
-  ::ack-delete
-  (fn [{:keys [db]} [_ id]]
+  ::ack-success
+  (fn [{:keys [db]} [_ uuid request-type]]
     (let [db (-> db
-                 (update-in [:productions :in-production] dissoc id)
-                 (notifications/clear-button-state id :delete))
+                 (update-in [:productions :in-production] dissoc uuid)
+                 (notifications/clear-button-state uuid request-type))
           empty? (-> db (get-in [:productions :in-production]) count (< 1))]
       (if empty?
         {:db db :dispatch [::fetch-productions]}
@@ -116,6 +116,18 @@
      (-> db
          (fork/set-submitting path false)
          (fork/set-server-message path message)))))
+
+(rf/reg-event-fx
+  ::recorded-production
+  (fn [{:keys [db]} [_ uuid id]]
+    {:db (notifications/set-button-state db uuid :recorded)
+     :http-xhrio
+     (as-transit {:method          :post
+                  :headers 	   (auth/auth-header db)
+                  :uri             (str "/api/productions/" id "/recorded")
+                  :on-success      [::ack-success uuid :recorded]
+                  :on-failure      [::ack-failure uuid :recorded]
+                  })}))

 (rf/reg-sub
  ::productions
@@ -254,7 +266,7 @@
        (if @(rf/subscribe [::notifications/button-loading? uuid :recorded])
          [:button.button.is-loading]
          (tooltip-button
-          {:on-click (fn [e] (rf/dispatch [::recorded-production uuid]))
+          {:on-click (fn [e] (rf/dispatch [::recorded-production uuid id]))
            :tooltip :mark-recorded
            :disabled (not has-manifest?)
            :icon "task"})))


add ns for a fn

add ns for a fn

--- .desc.clj
+++ .desc.clj
@@ -38,7 +38,7 @@
   :desc "takes a quoted list b/c it's a fn and not a macro like ns"}
  {:name "clojure.core/apply", :desc "last arg must be a list"}
  {:name "clojure.core/macroexpand-1", :desc "expands once"}
- {:name "macroexpand-all", :desc "recursive expand all"}
+ {:name "clojure.walk/macroexpand-all", :desc "recursive expand all"}
  {:name "clojure.core/macroexpand",
   :desc "expands top level macro recursively"}
  {:name "clojure.core/deref", :desc "never blocks"}