[TEMP COMMIT] Debugging

[TEMP COMMIT] Debugging

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

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -697,9 +697,10 @@
         startTime  (:startTime removedAugTTLessonInfo)
         endTime    (:endTime removedAugTTLessonInfo)
         ttRow      (get-in Timetable [day row])
-        minTimeIdx (time-helper/TIME-INDEX-MIN)
-        maxTimeIdx (time-helper/TIME-INDEX-MAX)]
-
+        minTimeIdx time-helper/TIME-INDEX-MIN
+        maxTimeIdx time-helper/TIME-INDEX-MAX]
+
+    (.log js/console "get-largest-consecutive-time-slot-freed-up-by-lesson")
     [
       ; Find the lesson right before the removed lesson
       (let [immediateTTLessonInfoBefore
@@ -761,7 +762,7 @@
         startTime  (:startTime removedAugTTLessonInfo)
         endTime    (:endTime removedAugTTLessonInfo)
         ModulesMap (aget js/window "ModulesMap")
-        dayRows    (get-in Timetable [day rowNum])
+        ttDay      (get-timetable-day day)

         ; This is the time range freed up by removal of the lesson
         [lowTimeIdx highTimeIdx]
@@ -770,10 +771,13 @@

         not-occupied?
         (fn [occupiedVec startTime endTime]
+          (.log js/console (str "inside not-occupied?, occupiedVec = " (.stringify js/JSON (clj->js occupiedVec))))
           (every? #(nil? %1)
                   (map #(nth occupiedVec %1)
                        (range startTime endTime))))]

+    (.log js/console "find-replacement-lessons-within-time")
+    (.log js/console (str "lowTimeIdx = " lowTimeIdx ", highTimeIdx = " highTimeIdx))
     (:augTTLessonInfoMapToShift
       (reduce
         (fn [reduceResult [rowIdx ttRow]]
@@ -788,12 +792,17 @@
                     (filter (fn [[ttLessonInfo _]]
                               (let [stime (:startTime ttLessonInfo)
                                     etime (:endTime ttLessonInfo)]
+                                (.log js/console (str "Executing, startTime = " stime ", endTime = " etime))
                                 (and (>= stime lowTimeIdx)
                                      (<= (dec etime) highTimeIdx)
                                      (not-occupied? occupiedVec stime etime))))
                             ttRow)]
+                (.log js/console "suspect above")
+                (.log js/console (str "rowIdx = " rowIdx))
+                (.log js/console (str "occupiedVec = " (.stringify js/JSON (clj->js occupiedVec))))
                 {:augTTLessonInfoMapToShift
                  (reduce (fn [augTTLessonInfoMap [ttLessonInfo $divElem]]
+                           (.log js/console ":augTTLessonInfoMapToShift")
                            (assoc augTTLessonInfoMap
                                   (assoc ttLessonInfo :day day :rowNum :rowIdx)
                                   $divElem))
@@ -802,6 +811,7 @@

                  :occupiedVec
                  (reduce (fn [occVec [ttLessonInfo _]]
+                           (.log js/console ":occupiedVec")
                            (reduce (fn [ov timeIdx] (assoc ov timeIdx true))
                                    occVec
                                    (range (:startTime ttLessonInfo)
@@ -810,9 +820,9 @@
                          ttLessonInfoToShift)})))
         {:augTTLessonInfoMapToShift {},
          ; nil = free slot, true = occupied slot
-         :occupiedVec      [vec (map (fn [t] nil) (range 800 2400 50))]}
+         :occupiedVec      (vec (map (fn [t] nil) (range 800 2400 50)))}
         ; go through each row in the day, below the current row
-        (drop (inc rowNum) (map vector (range (count dayRows)) dayRows))))))
+        (drop (inc rowNum) (map vector (range (count ttDay)) ttDay))))))

 (defn- shift-lesson-to-row
   "Shifts a lesson from its original row up to the given row.
@@ -838,6 +848,7 @@
                                   (children $destTableRow tdSelectorString)
                                   0)
         ttLessonInfo            (dissoc augTTLessonInfo :day :rowNum)]
+    (.log js/console (str "day = " day ", sourceRowNum = " sourceRowNum ", destinationRowNum = " destinationRowNum))
     ; Transfer lesson
 to the destination
     (.append $destTd $divElem)
     ; restore the colspan of the source
@@ -880,11 +891,13 @@
                        (< dayA dayB)))
                 lessonInfoSeq))]

+    (.log js/console "Hoo hoo")
     (loop [sortedAugTTLessonInfoSeq
            (sort-lesson-info-seq (exclude-lessons-on-empty-rows
                                    removedAugmentedTTLessonInfoSeq))

            nextLessonInfoVec    []]
+      (.log js/console "Inside the loop, the loop")
       (cond (and (empty? sortedAugTTLessonInfoSeq) (empty? nextLessonInfoVec))
             nil

@@ -906,7 +919,9 @@
                   (find-replacement-lessons-within-time currentAugTTLessonInfo)]

               (doseq [[augTTLessonInfo $divElem] augTTLessonInfoTo$DivElem]
+                (.log js/console "shift-lesson-to-row")
                 (shift-lesson-to-row rowNum augTTLessonInfo $divElem))
+              (.log js/console "gonna recur...")
               (recur (rest sortedAugTTLessonInfoSeq)
                      ; append newly shifted lessons to nextLessonInfoVec
                      (reduce (fn [augTTLessonInfoVec [augTTLessonInfo _]]
@@ -1031,15 +1046,21 @@
                 ttLessonInfo (dissoc augTTLessonInfo :day :rowNum)]
           (timetable-remove-lesson day rowNum ttLessonInfo)))

+        (.log js/console "Reached here man")
+
         ; Perform shifting due to removal of lesson
s
         (shift-lessons-upwards-to-replace-empty-slots augTTLessonInfoSeq)
+        (.log js/console "Here too bro")
         (timetable-prune-empty-rows affectedDaysSet)
+        (.log js/console "Whats up")

         ; Update `ModulesSelected`
         (update-ModulesSelected-for-affected-days affectedDaysSet)
+        (.log js/console "Boo ya!")

         ; Remove from `ModulesSelectedOrder`
         (set! ModulesSelectedOrder (remove #{moduleCode} ModulesSelectedOrder))
+        (.log js/console "I hear and obey!")
         ; Update Exhibit3 box
         (select2/select2-box-set-val select2/$Select2-Box
                                      (get-selected-module-codes-as-js-array)))))


Upgrade Eastwood

Upgrade Eastwood

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -12,7 +12,7 @@

         :plugins [[cider/cider-nrepl "0.9.0-SNAPSHOT"]
                   [codox "0.6.6"]
-                  [jonase/eastwood "0.1.4"]
+                  [jonase/eastwood "0.2.1"]
                   [lein-clojars "0.9.1"]
                   [lein-cloverage "1.0.2"]
                   [lein-difftest "2.0.0"]


show the col changes when db defn changed

The information that a column is there, we just need to show that it
happened

--- idecode/myappshare/mainapp.cljs
+++ idecode/myappshare/mainapp.cljs
@@ -498,7 +498,10 @@
                        ( let [column   (get columns col-key)
                               column-old-name  (:old-name   column)
                               column-new-name  (:new-name   column)
-                              ] (div {:style {:marginLeft "80px"}} (str "Column: " column-old-name))))
+                              ]
+                         (div {:style {:marginLeft "80px"}} (str "Column: " column-old-name))
+                         (div {:style {:marginLeft "120px"}} (str "New column name: " column-new-name))
+                        ))
                       ;[1 2]
                       (keys columns)
                       )


fixed ns alias & missing domain-ns

fixed ns alias & missing domain-ns

--- integration/dda/pallet/crate/dda_user_crate/instantiate_existing.clj
+++ integration/dda/pallet/crate/dda_user_crate/instantiate_existing.clj
@@ -15,7 +15,7 @@
 ; limitations under the License.
 (ns dda.pallet.crate.dda-user-crate.instantiate-existing
   (:require
-   [dda.cm.existing :as exisiting]
+   [dda.cm.existing :as existing]
    [dda.pallet.crate.dda-user-crate.user.os-user :as os-user]
    [dda.pallet.domain.dda-user-crate :as user]
    [dda.cm.operation :as operation]
@@ -43,12 +43,12 @@
    :password "EXISTING_USER_PASSWORD"})

 (def provider
-  (exisiting/provider provisioning-ip "node-id" "dda-httpd-group"))
+  (existing/provider provisioning-ip "node-id" "dda-httpd-group"))

 (def integrated-group-spec
   (merge
-   (user/dda-user-group (domain/crate-stack-configuration domain-config))
-   (exisiting/node-spec provisioning-user)))
+   (user/dda-user-group (user/crate-stack-configuration domain-config))
+   (existing/node-spec provisioning-user)))

 (defn integrated-group-spec []
   (merge


removed the :websocket-host when :js-client-host

--- sidecar/src/figwheel_sidecar/config.clj
+++ sidecar/src/figwheel_sidecar/config.clj
@@ -241,7 +241,7 @@
               (update-in [:figwheel] dissoc :websocket-host)
               (assoc-in [:figwheel :websocket-url]
                         (str "ws://" host ":" (:server-port figwheel-server) "/figwheel-ws")))
-            build))
+            (update-in build [:figwheel] dissoc :websocket-host)))
         build))
     build))


Update api.clj (#391)

Update api.clj (#391)

--- scheduler/src/cook/mesos/api.clj
+++ scheduler/src/cook/mesos/api.clj
@@ -749,7 +749,7 @@
       (str "http://" agent-hostname ":5051" "/files/read.json?path="
            (URLEncoder/encode directory "UTF-8")))
     (catch Exception e
-      (log/error e "Unable to retrieve directory path for" executor-id "on agent" agent-hostname)
+      (log/debug e "Unable to retrieve directory path for" executor-id "on agent" agent-hostname)
       nil)))

 (defn- instance->instance-map


[#1957] Keep (so far) client expectations

--- backend/src/akvo/lumen/endpoint/env.clj
+++ backend/src/akvo/lumen/endpoint/env.clj
@@ -12,19 +12,25 @@
   [{:keys [public-client flow-api lumen-deployment-color lumen-deployment-environment
            lumen-deployment-version piwik-site-id sentry-client-dsn]}]
   (fn [{tenant :tenant
+        query-params :query-params
         :as request}]
-    (let [[auth-url auth-client-id] (auth-data public-client)]
-      (response/response
-       (cond-> {"authClientId" auth-client-id
-                "authURL" auth-url
-                "flowApiUrl" (:url flow-api)
-                "lumenDeploymentColor" lumen-deployment-color
-                "lumenDeploymentEnvironment" lumen-deployment-environment
-                "lumenDeploymentVersion" lumen-deployment-version
-                "piwikSiteId" piwik-site-id
-                "tenant" (:tenant request)}
-         (string? sentry-client-dsn)
-         (assoc "sentryDSN" sentry-client-dsn))))))
+    (let [auth-type (get query-params "auth" "auth0")
+          [auth-url auth-client-id] (auth-data public-client)]
+      (if (s/valid? ::auth-type auth-type)
+        (response/response
+         (cond-> {"authClientId" auth-client-id
+                  "authURL" auth-url
+                  "authProvider" auth-type
+                  "flowApiUrl" (:url flow-api)
+                  "lumenDeploymentColor" lumen-deployment-color
+                  "lumenDeploymentEnvironment" lumen-deployment-environment
+                  "lumenDeploymentVersion" lumen-deployment-version
+                  "piwikSiteId" piwik-site-id
+                  "tenant" (:tenant request)}
+           (string? sentry-client-dsn)
+           (assoc "sentryDSN" sentry-client-dsn)))
+         (-> (response/response (str "Auth-provided not implemented: " auth-type))
+            (response/status 400))))))

 (defn routes [{:keys [routes-opts] :as opts}]
   ["/env" (merge {:get {:handler (handler opts)}}


some playing

some playing

--- src/didactic_waddle/core.cljs
+++ src/didactic_waddle/core.cljs
@@ -3,34 +3,37 @@
             [quil.middleware :as m]))

 (defn setup []
-  ; Set frame rate to 30 frames per second.
-  (q/frame-rate 30)
+  (q/frame-rate 60)
   ; Set color mode to HSB (HSV) instead of default RGB.
   (q/color-mode :hsb)
-  ; setup function returns initial state. It contains
-  ; circle color and position.
-  {:color 0
-   :angle 0})
+  {:color 0,
+   :size  1,
+   :growing true,
+   :angle 0
+   })

-(defn update-state [state]
-  ; Update sketch state by changing circle color and position.
-  {:color (mod (+ (:color state) 0.7) 255)
-   :angle (+ (:angle state) 0.1)})
+(defn update-state [s]
+  (let [size (:size s)
+        growing (:growing s)]
+    {:color (mod (+ (:color s) 0.7) 255),
+     :angle (mod (+ (:angle s) 0.02) (* 2 Math/PI)),
+     :size (+ size
+              (if growing 0.01 -0.01)),
+     :growing (if growing
+                (if (< 1.5 size) false true)
+                (if (< size 0.5) true false))}))

 (defn draw-state [state]
   ; Clear the sketch by filling it with light-grey color.
   (q/background 240)
   ; Set circle color.
-  (q/fill (:color state) 255 255)
-  ; Calculate x and y coordinates of the circle.
-  (let [angle (:angle state)
-        x (* 150 (q/cos angle))
-        y (* 150 (q/sin angle))]
-    ; Move origin point to the center of the sketch.
-    (q/with-translation [(/ (q/width) 2)
-                         (/ (q/height) 2)]
-      ; Draw the circle.
-      (q/ellipse x y 100 100))))
+  (q/stroke (:color state) 255 255)
+  (let [size (* 200 (:size state))
+        centre (/ (q/width) 2)]
+    (q/rect-mode :center)
+    (q/with-translation [centre centre]
+      (q/with-rotation [(:angle state)]
+        (q/rect 0 0 size size)))))

 (q/defsketch didactic-waddle
   :host "didactic-waddle"


fix divide by 0 error for no qa qc

fix divide by 0 error for no qa qc

--- src/clj/collect_earth_online/db/projects.clj
+++ src/clj/collect_earth_online/db/projects.clj
@@ -225,21 +225,23 @@
            percent    :percent
            smes       :smes} (:qaqcAssignment design-settings)
           {:keys [users]}    (:userAssignment 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))))
-                           []))))))
+      (if (= "none" qaqc-method)
+        assigned-plots
+        (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


Completed bindings from input values to input widgets.

--- src/fm/simrunner/gui/view.clj
+++ src/fm/simrunner/gui/view.clj
@@ -6,7 +6,8 @@
     :author "Frank Mosebach"}
   (:require
     [fm.simrunner.gui.core :as gui])
-  (:import
+  (:import
+    (java.io File)
     (java.awt Insets
               Dimension
               BorderLayout
@@ -148,7 +149,7 @@
         (.add (:widget view)))
     (assoc frame :contents {:simrunner-view view})))

-(defn widget-seq [widget]
+(defn- widget-seq [widget]
   (lazy-seq
     (cons widget
       (when-let [contents (vals (:contents widget))]
@@ -162,12 +163,37 @@
     (filter (comp input-ids :id meta)
             (widget-seq view))))

-(defmulti set-value {:private true} (fn [input _] (type input)))
-
-(defmethod set-value :text-input [input value]
+(defmulti set-value {:private true} (fn [input value]
+                                      [(type input) (type value)]))
+
+(defmethod set-value [:select-input Object] [input value]
+  (-> input
+      :contents
+      :select-text
+      :widget
+      (.setText (str value))))
+
+(defmethod set-value [:select-input File] [input value]
+  (set-value input (.getAbsolutePath value)))
+
+(defmethod set-value [:select-input nil] [input value]
+  (set-value input ""))
+
+(defmethod set-value [:text-input Object] [input value]
   (-> input
       :widget
       (.setText (str value))))
+
+(defmethod set-value [:text-input nil] [input value]
+  (set-value input ""))
+
+(defmethod set-value [:checkbox-input Object] [input value]
+  (-> input
+      :widget
+      (.setSelected (boolean value))))
+
+(defmethod set-value [:checkbox-input nil] [input value]
+  (set-value input false))

 (defmethod set-value :default [input value]
   (println (format "set-value{%s value: %s}" (type input) value)))
@@ -176,7 +202,8 @@
   (doseq [input (inputs view)]
     (let [input-id (:id (meta input))
           value    (input-id values)]
-      (set-value input value))))
+      (set-value input value)))
+  view)

 (defn render [view model]
   (update-inputs view (:input-values model)))


Clean up determine-org-settings-subpage while we're here.

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -203,16 +203,12 @@
     {:type :subpage :href "#projects" :title "Projects" :subpage :projects}
     {:type :subpage :href "#users" :title "Users" :subpage :users}]))

-(defn determine-org-settings-subpage
-  "Determines which subpage we should show the user. If they have
-   a plan, then we don't want to show them the plan page; if they
-   don't have a plan, then we don't want to show them the invoices page."
+(defn redirect-org-settings-subpage
+  "Piggiebacked plans can't go to :containers, :organizations, :billing, or :cancel.
+  Un-piggiebacked plans shouldn't be able to go to the old 'add plan' page. This function
+  selects a different page for these cases."
   [subpage plan org-name]
-  (cond (#{:users :projects} subpage)
-        ;; TODO: what does this condition do that :else subpage doesn't?
-        subpage
-
-        ;; Redirect :plan to :containers for paid plans that aren't piggiebacked.
+  (cond ;; Redirect :plan to :containers for paid plans that aren't piggiebacked.
         (and plan
              (pm/can-edit-plan? plan org-name)
              (= subpage :plan))
@@ -235,7 +231,7 @@
             plan (get-in app state/org-plan-path)
             org-data (get-in app state/org-data-path)
             org-name (:name org-data)
-            subpage (determine-org-settings-subpage (:project-settings-subpage app) plan org-name)
+            subpage (redirect-org-settings-subpage (:project-settings-subpage app) plan org-name)
             items (org-settings-nav-items plan org-name)]
         (html
          [:div.aside-user {:class (when (= :org-settings (:navigation-point app)) "open")}


search loads by url :)

search loads by url :)

--- pedestal-app/app/src/semtag_web/start.cljs
+++ pedestal-app/app/src/semtag_web/start.cljs
@@ -10,28 +10,37 @@
             [semtag-web.behavior :as behavior]
             [semtag-web.rendering :as rendering]
             [semtag-web.history :as history]
+            [clojure.string :as string]
             [goog.Uri]))

 (defn- put-message-on-page-load [app screen params]
-  ;; TODO
-  (if true
+  (if (re-find #"^search" (name screen))
     (p/put-message (:input app) (merge {msg/type :map-value msg/topic [:search]} params))
     ;; consider reuse with navbar-deltas
     (p/put-message (:input app) {msg/type :set-value msg/topic [:page] :value (name screen)})))

+;; use goog.Uri if it has an API for extracting param names - .getParameterValues doesn't cut it
+(defn- parse-params [url]
+  (when-let [params-string (re-find #"(?!.*\?).*" url)]
+    (-> params-string
+        (string/split #"\&")
+        (as-> pairs
+          (map #(let [[k v] (string/split % #"=")] [(keyword k) v]) pairs))
+        flatten
+        vec
+        (as-> vals (apply hash-map vals)))))
+
 (defn create-app [render-config]
-  (let [params {:query "ajax" :search-type "tagged"} ;; TODO
+  (let [params (parse-params window.location.hash)
         ;; For now we detect on hash. If I put a server to route all urls to this js app,
         ;; this could change to full urls.
         screen (or (route/url->screen (.-hash window.location) params)
                    (get-in behavior/example-app [:focus :default]))
-        _ (.log js/console "SCREEN" (pr-str screen))
-        behavior-with-new-default-focus (-> behavior/example-app
-                                            (assoc-in [:focus :default] screen)
-                                            (assoc-in [:focus screen]
-                                                      [[:app-model :search screen] [:app-model :home] [:app-model :navbar]]))
-        _ (.log js/console (pr-str (:focus behavior-with-new-default-focus)))
-        app (app/build behavior-with-new-default-focus)
+        behavior (cond-> behavior/example-app
+                   true (assoc-in [:focus :default] screen)
+                   (re-find #"^search" (name screen)) (assoc-in [:focus screen]
+                                                                [[:app-model :search screen] [:app-model :home] [:app-model :navbar]]))
+        app (app/build behavior)
         render-fn (push-render/renderer "content" render-config render/log-fn)
         app-model (render/consume-app-model app render-fn)]
     (app/begin app)


add "test" as default test alias/task.

add "test" as default test alias/task.

--- src/leiningen/ancient/utils/test.clj
+++ src/leiningen/ancient/utils/test.clj
@@ -18,14 +18,12 @@
     (catch Exception ex false)))

 (defn run-tests!
-  "Run regression tests (using the alias \"test-ancient\" in the project map)."
+  "Run regression tests (using the alias \"test-ancient\" in the project map or \"test\")."
   [project]
-  (if-let [task (get-in project [:aliases "test-ancient"])]
-    (let [r (run-test-task! project task)]
-      (when-not r
-        (main/info "Tests failed (use ':no-tests' if you want to suppress testing)."))
-      r)
-    (do
-      (main/info "No regression test task given.")
-      (main/info "(Use the alias 'test-ancient' to specify one or the option ':no-tests' to suppress testing.)")
-      true)))
+  (let [task (or (get-in project [:aliases "test-ancient"])
+                 (get-in project [:aliases "test"])
+                 "test")
+        r (run-test-task! project task)]
+    (when-not r
+      (main/info "Tests failed (use ':no-tests' if you want to suppress testing)."))
+    r))


Remove a broken extra nesting of :schema (for inline schemas)

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -71,6 +71,7 @@
   "Converts a simple (non-object) Schema into an inline Swagger Schema, with keys :type and perhaps :format, etc."
   [swagger-options swagger-object schema]
   (cond-let
+
     [data-type-mappings (:data-type-mappings swagger-options)
      data (get data-type-mappings schema)]

@@ -162,7 +163,7 @@
     (or (nil? schema-name) (nil? schema-ns))
     ;; The challenge here is nested schemas that may have names. Currently that will blow up.
     (let [[so' new-schema] (map->swagger-schema swagger-options swagger-object schema)]
-      [so' {:schema new-schema}])
+      [so' new-schema])

     ;; Avoid forward slash in the swagger name, as that's problematic.
     [swagger-name (str schema-ns \: schema-name)


removing debug

removing debug

--- cartagena-engine/src/cartagena/core.clj
+++ cartagena-engine/src/cartagena/core.clj
@@ -65,7 +65,6 @@
 (defn new-game!
   "Initializes a new game by creating a board, setting up players with 6 cards and pirates in jail, replacing the draw pile, setting the player order and current player.  Returns a map of the game state."
   [players]
-  (println "new-game! called")
   (let [board (initialize-board)
         players-draw-pile (loop [ps (vec (map initialize-player players))
                                  cards (initialize-cards)


Rename wrap-exception-handling to wrap-exception-reporting

--- src/main/clojure/cascade/request.clj
+++ src/main/clojure/cascade/request.clj
@@ -83,7 +83,7 @@
     wrap-serialize-html) req))

-(defn wrap-exception-handling
+(defn wrap-exception-reporting
   "Middleware for standard Cascade exception reporting; exceptions are caught and reported using the Cascade
 exception report view."
   [handler]
@@ -126,4 +126,4 @@
         (GET [(str root "/:domain/:path") :path #".*"]
           [domain path] (asset-handler asset-factories (keyword domain) path))
         (wrap-html-markup (or html-routes placeholder-routes)))
-      wrap-exception-handling)))+      wrap-exception-reporting)))


start tidying up select fn

start tidying up select fn

--- src/main/java/org/dada/demo/core.clj
+++ src/main/java/org/dada/demo/core.clj
@@ -177,36 +177,36 @@
     [tgt-type tgt-name retriever]
     ))

-(defn select [src-model output-class-name output-model-name key-name version-name properties]
-  (let [metadata (. src-model getMetadata)
-	src-class (. metadata getValueClass)
-	src-types (. metadata getAttributeTypes)
-	src-names (. metadata getAttributeNames)
+(defn select [src-model tgt-class-name tgt-model-name key-name version-name props]
+  (let [src-metadata (. src-model getMetadata)
+	src-class (. src-metadata getValueClass)
+	src-types (. src-metadata getAttributeTypes)
+	src-names (. src-metadata getAttributeNames)
 	src-map (apply array-map (interleave src-names src-types))
-	expanded-properties (map (fn [property]
-				     (let [src-name (first property)
-					   src-type (src-map src-name)]
-				       (apply expand-property src-class src-type property)))
-				 properties)
-	output-properties (map (fn [property] (vector (nth property 0) (nth property 1))) expanded-properties)
-   	output-types (map (fn [property] (nth property 0)) expanded-properties)
-   	output-names (map (fn [property] (nth property 1)) expanded-properties)
-	class-factory  (new ClassFactory)
-  	output-class (apply make-class class-factory output-class-name output-properties)
-   	output-getters (apply
-			conj
-			(array-map)
-			(map
-			 (fn [property]
-			     (let [type (nth property 0)
-				   name (nth property 1)]
-			       [name (make-proxy-getter output-class type name)]))
-			 expanded-properties))
-   	key-getter (output-getters key-name)
-   	version-getter (output-getters version-name)
-	output-metadata (new GetterMetadata output-class output-types output-names (vals output-getters))
-	view (new VersionedModelView output-model-name output-metadata key-getter version-getter)
-	transformer (transform src-model src-class src-map expanded-properties view output-class)]
+	fields (map (fn [prop]
+			(let [src-name (first prop)
+			      src-type (src-map src-name)]
+			  (apply expand-property src-class src-type prop)))
+		    props)
+	tgt-props (map (fn [field] (vector (nth field 0) (nth field 1))) fields)
+   	tgt-types (map (fn [field] (nth field 0)) fields)
+   	tgt-names (map (fn [field] (nth field 1)) fields)
+	class-factory (new ClassFactory)
+  	tgt-class (apply make-class class-factory tgt-class-name tgt-props)
+   	tgt-getters (apply
+		     conj
+		     (array-map)
+		     (map
+		      (fn [field]
+			  (let [type (nth field 0)
+				name (nth field 1)]
+			    [name (make-proxy-getter tgt-class type name)]))
+		      fields))
+   	tgt-key-getter (tgt-getters key-name)
+   	tgt-version-getter (tgt-getters version-name)
+	tgt-metadata (new GetterMetadata tgt-class tgt-types tgt-names (vals tgt-getters))
+	view (new VersionedModelView tgt-model-name tgt-metadata tgt-key-getter tgt-version-getter)
+	transformer (transform src-model src-class src-map fields view tgt-class)]
     view)
   )


Extract a common link generating fn.

Extract a common link generating fn.

--- src/klangmeister/ui/view.cljs
+++ src/klangmeister/ui/view.cljs
@@ -13,14 +13,16 @@
           :alt "Fork me on GitHub"
           :data-canonical-src "https://s3.amazonaws.com/github/ribbons/forkme_right_orange_ff7600.png"}]])

+(defn link [href title] [:a {:href href} title])
+
 (defn tabs []
   [:div {:id "menu"}
    [:ul
-    [:li [:a {:href "synthesis"} "Synthesis"]]
-    [:li [:a {:href "composition"} "Composition"]]
-    [:li [:a {:href "performance"} "Performance"]]
-    [:li [:a {:href "reference"} "Reference"]]
-    [:li [:a {:href "about"} "About"]]]])
+    [:li (link "synthesis" "Synthesis")]
+    [:li (link "composition" "Composition")]
+    [:li (link "performance" "Performance")]
+    [:li (link "reference" "Reference")]
+    [:li (link "about" "About")]]])

 (defn frame [content]
   [:div


Fixing a few typos

Fixing a few typos

--- src/leiningen/source_deps.clj
+++ src/leiningen/source_deps.clj
@@ -383,13 +383,13 @@

 (defn- mranderson [repositories dependencies {:keys [skip-repackage-java-classes unresolved-deps-hierarchy pname pversion] :as ctx} paths]
   (let [source-dependencies         (filter u/source-dep? dependencies)
-        resoved-deps-tree           (->> (aether/resolve-dependencies :coordinates source-dependencies :repositories repositories)
+        resolved-deps-tree          (->> (aether/resolve-dependencies :coordinates source-dependencies :repositories repositories)
                                          (aether/dependency-hierarchy source-dependencies))
-        unresolved-deps-tree        (expand-dep-hierarchy repositories resoved-deps-tree)]
+        unresolved-deps-tree        (expand-dep-hierarchy repositories resolved-deps-tree)]
         (u/info "retrieve dependencies and munge clojure source files")
     (if unresolved-deps-hierarchy
       (mranderson-unresolved-deps! unresolved-deps-tree paths ctx)
-      (mranderson-resolved-deps! unresolved-deps-tree resoved-deps-tree paths ctx))
+      (mranderson-resolved-deps! resolved-deps-tree unresolved-deps-tree paths ctx))
     (when-not (or skip-repackage-java-classes (empty? (u/class-files)))
       (class-deps-jar!)
       (u/apply-jarjar! pname pversion)


RS | #133 | Remove objectives from required namespaces in questions

--- src/objective8/back_end/domain/questions.clj
+++ src/objective8/back_end/domain/questions.clj
@@ -1,6 +1,5 @@
 (ns objective8.back-end.domain.questions
-  (:require [objective8.back-end.domain.objectives :as objectives]
-            [objective8.back-end.storage.uris :as uris]
+  (:require [objective8.back-end.storage.uris :as uris]
             [objective8.utils :as utils]
             [objective8.back-end.storage.storage :as storage]))


Fixed 'cleanup' mutator card.

Fixed 'cleanup' mutator card.

--- src/clj/funstructor/cards_functions.clj
+++ src/clj/funstructor/cards_functions.clj
@@ -338,7 +338,7 @@
   :mutator-cleanup
   [game player-key card & args]
   (let [opponent (get-opponent game player-key)]
-    ((apply-to-funstruct game player-key)
+    ((apply-to-funstruct game opponent)
      (fn [funstruct]
        (filterv #(not= :gap (:terminal %)) funstruct)))))


redo macro inner trace

redo macro inner trace

--- src/com/billpiel/sayid/inner_trace3.clj
+++ src/com/billpiel/sayid/inner_trace3.clj
@@ -347,6 +347,54 @@
   (or (meta form)
       (-> form first meta)))

+(defn tr-macro
+  [template tree-atom mcro v]
+  (let [tree @(produce-recent-tree-atom! (:inner-path template)
+                                         (:path-parents template)
+                                         tree-atom
+                                         :skip-closed-check true)]
+    (-> tree
+        (assoc :return v
+               :inner-tags [:macro mcro])
+        (merge template)
+        (update-tree! tree-atom))
+    v))
+
+(defn xpand-macro-form
+  [head form path-sym]
+  (list `tr-macro
+        path-sym
+        '$$
+        (keyword head)
+        form))
+
+(defn with-meta-safe
+  [v m]
+  (try
+    (with-meta v m)
+    (catch Exception e
+      v)))
+
+(defn xpand-macro
+  [head form src-map fn-meta path path-parent]
+  (let [xform (with-meta-safe (macroexpand form) (meta form))] ;; TODO be sure this is doing something
+    (let [path' (conj path :macro)
+          xmap (xpand-form xform
+                           src-map
+                           fn-meta
+                           path'
+                           path)]
+      (layer-xpansion-maps xmap
+                           {:path-parents {path path-parent}
+                            :templates {path (mk-tree-template src-map
+                                                               (get-form-meta-somehow form)
+                                                               fn-meta
+                                                               path
+                                                               :macro? true)}
+                            :form (xpand-macro-form head
+                                                    (:form xmap)
+                                                    (path->sym path))}))))
+
 (defn tr-loop-bind
   [template tree-atom v bnd-frm val-frm]
   (-> (produce-recent-tree-atom! (:inner-path template)
@@ -538,7 +586,7 @@
       (seq? form)
       (let [head (first form)]
         (cond
-          false "TODO"
+          (util/macro? head) (apply xpand-macro head args)
           (= 'loop head) (apply xpand-loop args)
           (= 'recur head) (apply xpand-recur args)
           (= 'if head) (apply xpand-if args)
@@ -670,19 +718,11 @@

 (defn f1
   [a]
-  (if (< a 2)
-    (recur (inc a))
-    a))
-
-(defn f2
-  [a]
-  (inc a)
-  (loop [b (+ a 0)]
-    (if (< b 2)
-      (recur (inc b))
-      b)))
-
-#_ (inner-tracer {:qual-sym 'com.billpiel.sayid.inner-trace3/f2
+  (-> a
+      inc
+      dec))
+
+#_ (inner-tracer {:qual-sym 'com.billpiel.sayid.inner-trace3/f1
                   :meta' {:ns 'com.billpiel.sayid.inner-trace3
                           :name 'com.billpiel.sayid.inner-trace3/f1}
                  :ns' 'com.billpiel.sayid.inner-trace3})
@@ -696,9 +736,9 @@
        (clojure.pprint/pprint trace/*trace-log-parent*)))

 #_ (binding [trace/*trace-log-parent* @com.billpiel.sayid.core/workspace]
-     (let [f2 (inner-tracer {:qual-sym 'com.billpiel.sayid.inner-trace3/f2
+     (let [f1 (inner-tracer {:qual-sym 'com.billpiel.sayid.inner-trace3/f1
                              :meta' {:ns 'com.billpiel.sayid.inner-trace3
-                                     :name 'com.billpiel.sayid.inner-trace3/f2}
+                                     :name 'com.billpiel.sayid.inner-trace3/f1}
                              :ns' 'com.billpiel.sayid.inner-trace3})]
-       (f2 1)
+       (f1 1)
        (clojure.pprint/pprint trace/*trace-log-parent*)))


minor fix

minor fix

--- src/mobile_patient/screen/login.cljs
+++ src/mobile_patient/screen/login.cljs
@@ -18,7 +18,7 @@
                   :style {:height 40}}]

        [ui/input {:placeholder "Password"
-                  :login @password
+                  :value @password
                   :on-change-text #(reset! password %)
                   :style {:height 40}}]


CMR-5787: Add comment.

CMR-5787: Add comment.

--- cmr-exchange/service-bridge/project.clj
+++ cmr-exchange/service-bridge/project.clj
@@ -192,6 +192,7 @@
                      ["junit" ":unit"]
                      ["ubercompile"]
                      ["build-uberjar"]]
+            ;; Build without version or security check.
             "build-no-check" ["do"
                               ["clean"]
                               ["lint"]


10x speedup to hierarchy induction with large domain sizes.

--- src/exp/sas_dag_hierarchy_induction.clj
+++ src/exp/sas_dag_hierarchy_induction.clj
@@ -25,6 +25,9 @@
 ;  Right now, we only do greedy ordering when not interleaving.  Should combine both.

 ;; TODO: when extending, find real set of possible inits, not everything.
+
+;; TODO: include optimizations from cylcic:
+ ;  Big domain edge-adding optimization (6x improvement on 20x20 taxi).

 ; Also, see many ideas for TODOs below.


hide tooltip when click entry

hide tooltip when click entry

--- src/frontend/cljs/alibi/entry_page.cljs
+++ src/frontend/cljs/alibi/entry_page.cljs
@@ -80,6 +80,7 @@
             (-> prev-state
                 (assoc-in [:form :selected-date :date] (:selected-date entry))
                 (assoc-in [:form :selected-task] (:selected-item entry))
+                (assoc :activity-graphic-mouse-over-entry {})
                 (assoc :selected-entry entry)))

           :cancel-entry


fix browser status

fix browser status

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


Use handy utils/restructure utility

Use handy utils/restructure utility

--- src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
+++ src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
@@ -174,7 +174,7 @@
 (defn operation-link [workspace-id job-id]
   ;; Note: using [:a ...] instead of style/create-link to be consistent with GCSFilePreviewLink
   [:a {:href "javascript:;"
-       :onClick #(modal/push-modal [OperationDialog {:workspace-id workspace-id :job-id job-id}])} job-id])
+       :onClick #(modal/push-modal [OperationDialog (utils/restructure workspace-id job-id)])} job-id])

 (react/defc CallDetail
   {:get-initial-state


Branch if path is absolute in stamp-and-clean/stamp-file, solves #482 (#483)

--- sidecar/src/figwheel_sidecar/build_middleware/stamp_and_clean.clj
+++ sidecar/src/figwheel_sidecar/build_middleware/stamp_and_clean.clj
@@ -18,10 +18,13 @@
 (def classpath-hash (.hashCode (System/getProperty "java.class.path")))

 (defn stamp-file [build-config]
-  (io/file (or (System/getProperty "user.dir")
-               (io/file "."))
-           (or (-> build-config :build-options :output-dir) "out")
-           ".figwheel-compile-stamp"))
+  (let [output-dir (io/file (or (-> build-config :build-options :output-dir) "out"))]
+    (if (.isAbsolute output-dir)
+      (io/file (.getCanonicalPath output-dir) ".figwheel-compile-stamp")
+      (io/file (or (System/getProperty "user.dir")
+                   (io/file "."))
+               output-dir
+               ".figwheel-compile-stamp"))))

 ;; this provides a simple map and stable order for hashing
 ;; TODO this should return a seq of map entries


add test-cus, test-getConstructors

add test-cus, test-getConstructors

--- test/app/test/javaparser/navigation_test.clj
+++ test/app/test/javaparser/navigation_test.clj
@@ -3,6 +3,7 @@
   (:use [app.model.protocols])
   (:use [app.model.javaparser])
   (:use [app.javaparser.navigation])
+  (:use [app.javaparser.parsing])
   (:use [app.test.helper])
   (:use [clojure.test]))

@@ -79,10 +80,19 @@
 ; cus
 ; ============================================

+(deftest test-cus
+  (let [commentsCus (cus "test-resources/sample-codebases/javaparser/japa/parser/ast/comments")]
+    (is (= 6 (count commentsCus)))))
+
 ; ============================================
 ; getConstructors
 ; ============================================

+(deftest test-getConstructors
+  (let [blockCommentFile (parseFileByName "test-resources/sample-codebases/javaparser/japa/parser/ast/comments/BlockComment.java")
+        blockComment (first (allClasses blockCommentFile))]
+    (is (= 3 (count (getConstructors blockComment))))))
+
 ; ============================================
 ; allConstructorsForCus
 ; ============================================


azulenoids.clj: simplified some code.

azulenoids.clj: simplified some code.

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -64,15 +64,13 @@

 (defn apply-to-template [ds oct2tmp]
   (let [tmp2oct (clojure.set/map-invert oct2tmp)
-        tmp (DynamicDSymbol. template)
-        set-op (fn [D]
-                 (if (not (.definesOp tmp 2 D))
-                   (.redefineOp tmp 2 D (oct2tmp (.op ds 2 (tmp2oct D))))))
-        set-v (fn [D]
-                (if (not (.definesV tmp 1 2 D))
-                  (.redefineV tmp 1 2 D (.v ds 1 2 (tmp2oct D)))))]
-    (doall (map set-op (keys tmp2oct)))
-    (doall (map set-v (keys tmp2oct)))
+        tmp (DynamicDSymbol. template)]
+    (doseq [D (keys tmp2oct)]
+      (if (not (.definesOp tmp 2 D))
+        (.redefineOp tmp 2 D (oct2tmp (.op ds 2 (tmp2oct D))))))
+    (doseq [D (keys tmp2oct)]
+      (if (not (.definesV tmp 1 2 D))
+        (.redefineV tmp 1 2 D (.v ds 1 2 (tmp2oct D)))))
     (-> tmp .dual .minimal .canonical)))

 (def octa-sets (filter (fn [ds] (-> ds max-curvature .isNegative not))
@@ -81,8 +79,7 @@
 (def octa-syms (lazy-mapcat syms-for octa-sets))

 (defn azul-syms-raw []
-  (lazy-mapcat (fn [ds] (map (partial apply-to-template ds) boundary-mappings))
-               octa-syms))
+  (for [ds octa-syms o2t boundary-mappings] (apply-to-template ds o2t)))

 (def azul-syms
   (letfn [(step [acc ds]
@@ -91,13 +88,13 @@
                   (if (seen key)
                     [seen false]
                     [(conj seen key) ds])))]
-         (filter identity
-                 (map second
-                      (reductions step [#{} false] (azul-syms-raw))))))
+         (for [entry (reductions step [#{} false] (azul-syms-raw))
+               :when (second entry)]
+           (second entry))))

 (defn -main []
   (do
-    (doall (map (fn [ds] (println (str ds))) azul-syms))
+    (doseq [ds azul-syms] (println (str ds)))
     (println "#Generated:")
     (println "#   " (count octa-sets) "octagonal D-sets.")
     (println "#   " (count octa-syms) "octagonal D-symbols.")


(PDB-3857) Make fact path gc compatible with pg 10+

Don't use set returning functions in statement projections.  We were
doing that in the fact path gc operations, and postgres no longer
allows them there (as of version 10).

The approach taken here should also stop pdb from generating a flood
of tiny temp files when running the gc query.

cf. (PDB-3924)

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -1123,38 +1123,37 @@
 (defn delete-unused-fact-paths []
   "Deletes paths from fact_paths that are no longer needed by any
   factset.  In the unusual case where a path changes type, the
-  previous version will linger."
+  previous version will linger.  This requires a parent transaction
+  with at least a repeatable-read isolation level (and may or may not
+  need postgres' \"stronger than the standard\" repeatable-read
+  behavior).  Otherwise paths could be added to fact_paths elsewhere
+  during the gc, not be noticed, and then be deleted at the end."
+  ;; Use a temp table for now until we figure out why pg is creating a
+  ;; vast number of temp files when this is all handled as a single
+  ;; query.  (PDB-3924)
   (jdbc/do-commands
-   ["with recursive live_paths(key, path, value) as"
-    "  (select key, key as path, value"
-    "     from (select (jsonb_each(stable||volatile)).*"
-    "             from factsets) as base_case"
-    "   union all"
-    "   select sub_path as key,"
-    "          sub_paths.path||'#~'||sub_path as path,"
-    "          sub_value as value"
-    "     from (select *"
-    "             from (select path,"
-    "                          case jsonb_typeof(value)"
-    "                            when 'object'"
-    "                              then (jsonb_each(value)).key"
-    "                            when 'array'"
-    "                              then generate_series(0, jsonb_array_length(value - 1))::text"
-    "                            end"
-    "                            as sub_path,"
-    "                          case jsonb_typeof(value)"
-    "                            when 'object'"
-    "                              then (jsonb_each(value)).value"
-    "                            when 'array'"
-    "                              then jsonb_array_elements(value)"
-    "                          end"
-    "                          as sub_value"
-    "                     from live_paths) as candidates"
-    "             where candidates.sub_path is not null)"
-    "               as sub_paths)"
-    "  delete from fact_paths fp"
-    "    where not exists (select 1 from live_paths"
-    "                        where live_paths.path = fp.path)"]))
+   ["with recursive live_paths(path, value) as"
+    "   (select key as path, value"
+    "      from (select (jsonb_each(stable||volatile)).* from factsets) as base_case"
+    "      union"
+    "        select path||'#~'||sub_level.key as path,"
+    "               sub_level.value"
+    "          from live_paths,"
+    "          lateral (select *"
+    "                     from (select (jsonb_each(value)).*"
+    "                             where jsonb_typeof(value) = 'object') as sub_fields"
+    "                     union (select generate_series(0, jsonb_array_length(value - 1))::text as key,"
+    "                                   jsonb_array_elements(value) as value"
+    "                              where jsonb_typeof(value) = 'array')) as sub_level)"
+    "   select path into unlogged tmp_live_paths from live_paths"]
+
+   "analyze tmp_live_paths"
+
+   ["delete from fact_paths fp"
+    "  where not exists (select 1 from tmp_live_paths"
+    "                      where tmp_live_paths.path = fp.path)"]
+
+   "drop table tmp_live_paths"))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Reports
@@ -1435,5 +1434,7 @@
      (jdbc/with-transacted-connection db
        (delete-unassociated-params!)
        (delete-unassociated-environments!))
-     (jdbc/with-transacted-connection db
+     (jdbc/with-transacted-connection' db :repeatable-read
+       ;; May or may not require postgresql's "stronger than the
+       ;; standard" behavior for repeatable read.
        (delete-unused-fact-paths)))))


encode user-input search terms when sending to server (#553)

--- src/cljs/org/broadinstitute/firecloud_ui/common/entity_table.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/common/entity_table.cljs
@@ -114,7 +114,7 @@
                {:endpoint (endpoints/get-entities-paginated (:workspace-id props) type
                                                             {"page" current-page
                                                              "pageSize" rows-per-page
-                                                             "filterTerms" filter-text
+                                                             "filterTerms" (js/encodeURIComponent filter-text)
                                                              "sortField" sort-field
                                                              "sortDirection" (name sort-order)})
                 :on-done (fn [{:keys [success? get-parsed-response status-text status-code]}]


Remove old comment and code about target and lein 1.

--- lein-protobuf/src/leiningen/protobuf.clj
+++ lein-protobuf/src/leiningen/protobuf.clj
@@ -20,12 +20,8 @@
   (java.net.URL.
    (format "http://protobuf.googlecode.com/files/protobuf-%s.zip"  version)))

-;; In lein 1 there was a :target-dir key that defaulted to "." and wasn't really
-;; used much. In lein 2, things that are generated by plugins and such are
-;; supposed to go in :target-path. This will default to 'target'. We don't want
-;; to wait for this, so we'll simulate it here.
 (defn target [project]
-  (doto (io/file (or (:target-path project) "target"))
+  (doto (io/file (:target-path project))
     .mkdirs))

 (defn- proto-dependencies


Handle questionmarks in URLs containing DOIs.

--- src/member_domains/lookup.clj
+++ src/member_domains/lookup.clj
@@ -114,7 +114,17 @@
       ; Or try this substring.
       (if-let [clean-doi (resolve-doi-maybe-escaped doi)]
         ; resolve-doi may alter the DOI it returns, e.g. resolving a shortDOI to a real DOI or lower-casing.
-        clean-doi
+
+        ; We have a working DOI!
+        ; Just check it does't contain a sneaky question mark which would still resolve e.g. http://www.tandfonline.com/doi/full/10.1080/00325481.2016.1186487?platform=hootsuite
+        ; If there is a question mark, try removing it to see if it still works.
+        (if (.contains clean-doi "?")
+          (let [before-q (first (.split clean-doi "\\?"))]
+            (if (resolve-doi before-q)
+              before-q
+              clean-doi))
+          clean-doi)
+
         (recur (inc i) (.substring doi 0 (- (.length doi) 1)))))))

 (defn first-valid
@@ -253,7 +263,7 @@
 (defn resolve-doi-from-url
   "Take a URL and try to resolve it to find what valid DOI it corresponds to."
   [url]
-  (info "Try to resolve:" url)
+  (info "Attempt resolve-doi-from-url: " url)

   ; Check if we want to bother with this URL.

@@ -283,6 +293,7 @@
 (defn get-embedded-doi-from-string
   "Get valid DOI that's embedded in a URL (or an arbitrary string) by a number of methods."
   [url]
+  (info "Attempt get-embedded-doi-from-string")
   ; First see if cleanly represented it's in the GET params.
   (if-let [doi (-> url extract-doi-from-get-params validate-doi)]
     doi
@@ -322,11 +333,12 @@

               ; Now take the first one that we could validate.
               doi (first-valid distinct-candidates)]
-          doi)))))
+          doi)))))

 (defn cleanup-doi
   "Take a URL or DOI or something that could be a DOI, return the valid DOI if it is one."
   [potential-doi]
+  (info "Attempt cleanup-doi")
   (when (or
     (re-matches whole-doi-re potential-doi)
     (re-find doi-re potential-doi)
@@ -352,7 +364,7 @@
       [:embedded embedded-valid-doi]

     ; Try to treat it as a Publisher URL that must be fetched to extract its DOI.
-    (if-let [resolved-valid-doi (resolve-doi-from-url input)]
+    (if-let [resolved-valid-doi (when-let [url (try-url input)] (resolve-doi-from-url input))]
       [:resolved resolved-valid-doi]
       nil))))


simpler `rotations`

simpler `rotations`

--- src/midje/util/form_utils.clj
+++ src/midje/util/form_utils.clj
@@ -127,10 +127,8 @@
 (defn rotations
   "Returns a lazy seq of all rotations of a seq"
   [coll]
-  (map-indexed
-    (fn [idx _]
-      (lazy-cat (drop idx coll) (take idx coll)))
-    coll))
+  (for [i (range 0 (count coll))]
+    (lazy-cat (drop i coll) (take i coll))))

 (defmacro pred-cond
   "Checks each predicate against the item, returning the corresponding


New tests: test-render-front-page-existence, test-render-error-page-existence, and test-get-hostname-existence

--- test/emender_jenkins/server_test.clj
+++ test/emender_jenkins/server_test.clj
@@ -47,6 +47,24 @@

+(deftest test-render-front-page-existence
+    "Check that the emender-jenkins.server/render-front-page definition exists."
+    (testing "if the emender-jenkins.server/render-front-page definition exists."
+        (is (callable? 'emender-jenkins.server/render-front-page))))
+
+
+(deftest test-render-error-page-existence
+    "Check that the emender-jenkins.server/render-error-page definition exists."
+    (testing "if the emender-jenkins.server/render-error-page definition exists."
+        (is (callable? 'emender-jenkins.server/render-error-page))))
+
+
+(deftest test-get-hostname-existence
+    "Check that the emender-jenkins.server/get-hostname definition exists."
+    (testing "if the emender-jenkins.server/get-hostname definition exists."
+        (is (callable? 'emender-jenkins.server/get-hostname))))
+
+
 ;(get-api-command nil "/api")

 ;(get-api-command "/" "/api")


performance improvement

performance improvement

--- src/cljs/triboard/ai/ai.cljs
+++ src/cljs/triboard/ai/ai.cljs
@@ -92,10 +92,11 @@
     (leaf-score ai game)
     (let [turn (game/current-turn game)
           transitions (turn/player-transitions turn)
-          next-games (map #(game/play-move game (first %)) transitions)
           min-max (if (= (:player ai) (:player turn)) max min)]
       (apply min-max
-        (map #(tree-score ai % (dec depth)) next-games)))
+        (map
+          #(tree-score ai (game/play-move game (first %)) (dec depth))
+          transitions)))
     ))

 (defn test-score-tree
@@ -105,10 +106,10 @@
         ai (make-ai (:board turn) (:player turn))]
     (tree-score ai init-game 2)))

-#_(defn benchmark
+(defn benchmark
   []
   (time (dotimes [i 10]
-          (test-score-tree)
+          (time (test-score-tree))
           )))

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


Setup new shape proportions on the end of resize.

--- src/uxbox/main/ui/shapes/selection.cljs
+++ src/uxbox/main/ui/shapes/selection.cljs
@@ -44,11 +44,12 @@
 ;; --- Resize Implementation

 (defn- start-resize
-  [vid shape]
+  [vid sid]
   (letfn [(on-resize [[delta ctrl?]]
             (let [params {:vid vid :delta (assoc delta :lock ctrl?)}]
-              (rs/emit! (uds/update-vertex-position shape params))))
+              (rs/emit! (uds/update-vertex-position sid params))))
           (on-end []
+            (rs/emit! (uds/setup-proportions sid))
             (rlocks/release! :shape/resize))]
     (let [stoper (->> wb/events-s
                       (rx/map first)
@@ -59,7 +60,7 @@
                       (rx/with-latest-from vector wb/mouse-ctrl-s))]
       (rlocks/acquire! :shape/resize)
       (when @wb/alignment-ref
-        (rs/emit! (uds/initial-vertext-align shape vid)))
+        (rs/emit! (uds/initial-vertext-align sid vid)))
       (rx/subscribe stream on-resize nil on-end))))

 ;; --- Selection Handlers (Component)


Added some splice-sep variations for testing

Signed-off-by: Laurent Petit <35308fdebc253c376da9c08cd3eb3d3f02225328@gmail.com>

--- src/paredit/core_commands.clj
+++ src/paredit/core_commands.clj
@@ -445,7 +445,10 @@
                 "(foo (b|ar baz) quux)" "(foo b|ar baz quux)"
                 "(bar| baz)" "bar| baz"
                 "(bar | baz)" "bar | baz"
+                "(foo (ba|r) baz)" "(foo ba|r baz)"
                 ; TODO Following edge case tests do not pass
+                ;"(foo \"bar|\" baz)" "(foo bar| baz)"
+                ;"(foo \"ba|r\" baz)" "(foo ba|r baz)"
                 ;"(foo (|) baz)" "(foo | baz)"
                 ;"(foo (bar|) baz)" "(foo bar| baz)"
                 }]


CMR-3387: Removing debug code.

CMR-3387: Removing debug code.

--- access-control-app/src/cmr/access_control/data/group_json_results_handler.clj
+++ access-control-app/src/cmr/access_control/data/group_json_results_handler.clj
@@ -24,7 +24,6 @@

 (defmethod elastic-results/elastic-result->query-result-item [:access-group :json]
   [context query elastic-result]
-  (proto-repl.saved-values/save 4 query elastic-result)
   (let [field-values (:fields elastic-result)
         item (util/map-values first (dissoc field-values :members))]
     (if (include-members? query)


[victoryw] change the x text

[victoryw] change the x text

--- go-visual/src/go_visual/core.clj
+++ go-visual/src/go_visual/core.clj
@@ -23,7 +23,7 @@
   [statis]
   (spit "../go-visual-site/data.json" (json/write-str
                                        {:title (:name (first statis))
-                                        :categories (map #(format "%s-%s" (:name %) (:counter %)) statis)
+                                        :categories (map #(:counter %) statis)
                                         :data (map #(- (:statges-run-times %) (:statges %)) statis)})))

 (defn statistic-pipeline-instace


more cleaning

more cleaning

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/data/import_data.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/data/import_data.cljs
@@ -14,7 +14,7 @@

 (react/defc Page
   {:render
-   (fn [{:keys [state props refs this]}]
+   (fn [{:keys [state refs this]}]
      [:div {:style {:textAlign "center"}}
       (when (:loading? @state)
         [comps/Blocker {:banner "Uploading file..."}])


Add nl to end of file.

Add nl to end of file.

--- src/tryclojure/views/home.clj
+++ src/tryclojure/views/home.clj
@@ -37,4 +37,5 @@
   (root-html))

 (defpage "/home" []
-  (home-html))+  (home-html))
+


Move footer fn.

Move footer fn.

--- src/tryclojure/views/home.clj
+++ src/tryclojure/views/home.clj
@@ -3,6 +3,12 @@
             [noir.response :refer [redirect]]
             [hiccup.element :refer [javascript-tag link-to unordered-list]]
             [hiccup.page :refer [include-css include-js html5]]))
+
+(defn footer []
+  [:div.footer "home
+                try isla
+                github
+                mary rose cook"])

 (defn repl-html [mode title]
   (html5
@@ -36,12 +42,6 @@
       (javascript-tag
        (str "mode = '" mode "';"))]]]
    (footer)))
-
-(defn footer []
-  [:div.footer "home
-                try isla
-                github
-                mary rose cook"])

 (defpage "/repl" []
   (repl-html "isla" "Try Isla"))


Default values shouldn't depend on other bindings

As it happens, this currently compiles, but it's prone to breaking. It
depends on the order in which the `:keys` are processed, which is not
guaranteed.

See CLJ-1613 (I haven't found a similar bug listed for CLJS, but it's
the same issue).

http://dev.clojure.org/jira/browse/CLJ-1613

--- src-cljs/frontend/api.cljs
+++ src-cljs/frontend/api.cljs
@@ -58,10 +58,10 @@

 ;; Note that dashboard-builds-url can take a :page (within :query-params)
 ;; and :builds-per-page, or :limit and :offset directly.
-(defn dashboard-builds-url [{:keys [branch repo org admin deployments query-params builds-per-page offset limit]
-                             :or {offset (* (get query-params :page 0) builds-per-page)
-                                  limit builds-per-page}}]
-  (let [url (cond admin "/api/v1/admin/recent-builds"
+(defn dashboard-builds-url [{:keys [branch repo org admin deployments query-params builds-per-page offset limit]}]
+  (let [offset (or offset (* (get query-params :page 0) builds-per-page))
+        limit (or limit builds-per-page)
+        url (cond admin "/api/v1/admin/recent-builds"
                   deployments "/api/v1/admin/deployments"
                   branch (gstring/format "/api/v1/project/%s/%s/tree/%s" org repo branch)
                   repo (gstring/format "/api/v1/project/%s/%s" org repo)


Added tests for the apply-function

Added tests for the apply-function

--- kanbanik-statistics/src/test/clojure/org/kanbanik/statistics_test.clj
+++ kanbanik-statistics/src/test/clojure/org/kanbanik/statistics_test.clj
@@ -67,4 +67,11 @@
     (is (= 0 (count (apply-filter {} [{} w1]))))
     )
   )
+
+  (testing "apply-function"
+    (is (= 0 (apply-function :cnt [])))
+    (is (= 1 (apply-function :cnt [:x])))
+    (is (= nil (apply-function :not-existing [])))
+    (is (= nil (apply-function nil [])))
+  )
 )


(maint) Test that setting health check reg works.

--- test/puppetlabs/jdbc_util/pool_test.clj
+++ test/puppetlabs/jdbc_util/pool_test.clj
@@ -42,8 +42,8 @@
                  :connection-test-query "SELECT 1 FROM ANYWHERE;"
                  :minimum-idle 5
                  :maximum-pool-size 200
+                 :health-check-registry health-reg
                  ;; :metric-registry
-                 ;; :health-check-registry
                  :pool-name "bob"})]
     (testing "can set options on a HikariConfig"
       (are [value getter] (= value (getter config))
@@ -58,7 +58,8 @@
         "SELECT 1 FROM ANYWHERE;" .getConnectionTestQuery
         5 .getMinimumIdle
         200 .getMaximumPoolSize
-        "bob" .getPoolName))
+        "bob" .getPoolName
+        health-reg .getHealthCheckRegistry))

     (let [config (pool/options->hikari-config
                   {:username "nobody"


Adapt frontend images ns to new path helpers and new storage name.

--- src/uxbox/frontend/images.clj
+++ src/uxbox/frontend/images.clj
@@ -8,7 +8,7 @@
   (:require [promesa.core :as p]
             [catacumba.http :as http]
             [storages.core :as st]
-            [uxbox.media :as md]
+            [uxbox.media :as media]
             [uxbox.schema :as us]
             [uxbox.services :as sv]
             [uxbox.services.images :as si]
@@ -75,15 +75,18 @@

 (defn- resolve-path
   [{:keys [path] :as imagentry}]
-  (assoc imagentry :url (str (st/public-url md/storage path))))
+  (let [storage media/images-storage
+        url (str (st/public-url storage path))]
+    (assoc imagentry :url url)))

 (defn create-image
   [{user :identity data :data}]
   (let [{:keys [file id] :as data} (validate-form! data create-image-schema)
         id (or id (uuid/random))
-        filename (paths/name file)
-        extension (paths/extension filename)]
-    (->> (st/save md/storage filename file)
+        filename (paths/base-name file)
+        extension (paths/extension filename)
+        storage media/images-storage]
+    (->> (st/save storage filename file)
          (p/mapcat (fn [path]
                      (sv/novelty {:id id
                                   :type :create/image


update deps

update deps

--- lein/profiles.clj
+++ lein/profiles.clj
@@ -1,10 +1,10 @@
 {:user
- {:plugins      [[venantius/ultra "0.4.1"]
+ {:plugins      [[venantius/ultra "0.5.1"]
                  [refactor-nrepl "2.2.0"]
-                 [cider/cider-nrepl "0.11.0"]]
-  :dependencies [[spyscope "0.1.4"]
+                 [cider/cider-nrepl "0.14.0"]]
+  :dependencies [[spyscope "0.1.6"]
                  [org.clojure/tools.namespace "0.2.11"]
-                 [io.aviso/pretty "0.1.26"]
+                 [io.aviso/pretty "0.1.33"]
                  [im.chit/vinyasa "0.4.7"]]
   :injections
   [(require 'spyscope.core)


+(defn generate-n)

+(defn generate-n)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -90,6 +90,25 @@
       (->
        (lightning-bolts language-model spec 0 total-depth :max-total-depth max-total-depth)
        (add-all-comps language-model total-depth false max-total-depth spec)))))
+
+(defn generate-n
+  "Returns all possible expressions generated by the given language model, constrained by the given spec.
+   Depending on the grammar in the language model, could be an infinite number of expressions."
+  [n spec language-model total-depth
+   & {:keys [max-total-depth truncate-children]
+      :or {max-total-depth max-total-depth
+           truncate-children true}}]
+  (let [total-depth (if total-depth total-depth 0)]
+    (if truncate-children
+      (take n
+            (->
+             (lightning-bolts language-model spec 0 total-depth :max-total-depth max-total-depth)
+             (add-all-comps language-model total-depth true max-total-depth spec)
+             (truncate-expressions [[:head]] language-model)))
+      (take n
+            (->
+             (lightning-bolts language-model spec 0 total-depth :max-total-depth max-total-depth)
+             (add-all-comps language-model total-depth true max-total-depth spec))))))

 (defn lightning-bolts
   "Returns a lazy-sequence of all possible bolts given a spec, where a bolt is a tree


more on merging

more on merging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -162,6 +162,22 @@
                                  (+ 1 depth)
                                  max-depth
                                  top-bolt)))))))
+
+(defn add-bolt-at-2 [bolt-at model depth max-depth]
+  (mapfn #(do-defaults % model)
+         (if (= false (get-in bolt-at [:phrasal]))
+           [bolt-at]
+           (let [comp-paths (find-comp-paths bolt-at)
+                 comp-bolts (map #(comp-path-to-bolts bolt-at % model depth max-depth)
+                                 comp-paths)]
+             (when (not (some empty? comp-bolts))
+               (add-comps bolt-at
+                          model
+                          comp-paths
+                          comp-bolts
+                          (+ 1 depth)
+                          max-depth
+                          bolt-at))))))
 (defn generate2
   "Return all expressions matching spec _spec_ given the model _model_."
   [spec model]
@@ -170,23 +186,8 @@
         max-depth max-total-depth]
     (mapfn #(do-defaults % model)
            (flatten
-            (mapfn (fn [bolt-at]
-                     (mapfn #(do-defaults % model)
-                            (if (= false (get-in bolt-at [:phrasal]))
-                              [bolt-at]
-                              (let [comp-paths (find-comp-paths bolt-at)
-                                    comp-bolts (map #(comp-path-to-bolts bolt-at % model depth max-depth)
-                                                    comp-paths)]
-                                (when (not (some empty? comp-bolts))
-                                  (add-comps bolt-at
-                                             model
-                                             comp-paths
-                                             comp-bolts
-                                             (+ 1 depth)
-                                             max-depth
-                                             bolt-at))))))
+            (mapfn #(add-bolt-at-2 % model depth max-depth)
                    (lightning-bolts model spec 0 max-total-depth))))))
-
 (defn generate-n
   "Returns all possible expressions generated by the given language model, constrained by the given spec.
    Depending on the grammar in the language model, could be an infinite number of expressions."


tests fail

tests fail

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -83,10 +83,15 @@
                            (create-path-in path-to-comp complement)))
                        paths))))

+     (remove (fn [tree-parts]
+               (some #(= :fail %) tree-parts)))
+
      (map (fn [tree-parts]
             (reduce (fn [a b]
                       (unify-and-log a b model))
                     tree-parts)))
+
+     (remove #(= :fail %))

      (map #(do-defaults % model)) ;; for each tree, run model defaults.


a bit broken

a bit broken

--- src/bossig/kaosinst.clj
+++ src/bossig/kaosinst.clj
@@ -4,6 +4,10 @@

 ;;helpers
 (def tr (seq->stream (cycle-between 1 1 16 0.1 15)))
+
+
+
+
 (defn drop-nth [n coll]
   ;;keep indexed changes coll from [] to () so added (vec)
   (vec (keep-indexed #(if (not= %1 n) %2) coll))
@@ -78,11 +82,66 @@
 (event-debug-off)

 (tr)
-(defn wavelines [topsegments bottomsegments maxheight minheight color offset]
-  (dotimes [n 100]
-    (q/line (* n 50) 0
-            (* n 50) 1000)
+
+
+(defn tester  [bottomsegments minbottom maxbottom waveint]
+  (range minbottom (rand-int maxbottom ) waveint ))
+
+(defn tester []
+  (fn this [a b] (+ a b) ))
+
+(defn tester [start end step]
+  (concat start  (range  (last start) end step))
+  )
+
+( take 3 (iterate  (tester [1] 20 2)) 3)
+
+(tester 1 5 200 3)
+
+(defn tester []
+  (let [x [0 200 150 500 200 0]
+        min 0
+        max 300
+        ]
+    (dotimes [n 6]
+
+      )
     )
+  )
+
+
+
+
+(defn wavelines [wavewidth waveint topsegments bottomsegments starttop mintop maxtop startbottom minbottom maxbottom color offset]
+
+
+  (q/stroke-weight 1)
+  (let [top [starttop]
+        bottom [startbottom]
+        ]
+    (dotimes [t topsegments]
+      (let [x (q/random mintop maxtop)]
+        ;(println)
+        (into [] (concat top (range (last top) x waveint )))
+        ((if (= t topsegments)
+           ()
+           else-expr) )
+        )
+
+      )
+
+
+    (dotimes [b bottomsegments]
+      (let [x (q/random minbottom maxbottom)]
+        ( into [] (concat bottom (range (last bottom) x waveint )))
+        ))
+
+
+    (dotimes [n 10]
+      (q/line (* n 5) (nth top 0)
+              (* n 5) (nth bottom 0)
+              )
+      ))

   )


add type hint to avoid reflection warning

--- src/bract/core/impl.clj
+++ src/bract/core/impl.clj
@@ -105,7 +105,7 @@

 (defn maxlen
-  [v len]
+  [v ^long len]
   (let [s (str v)]
     (if (> (count s) len)
       (-> (subs s 0 len)


Refactor

Refactor

--- src/buildviz/gosync.clj
+++ src/buildviz/gosync.clj
@@ -97,24 +97,25 @@
           :scheduledDateTime (tc/from-long scheduled-date)})
        jobs))

-(defn get-stage-instances [pipeline stage offset]
-  (let [stage-history (get-json "/api/stages/%s/%s/history/%s" pipeline stage offset)
+(defn get-stage-instances [pipeline stage-name offset]
+  (let [stage-history (get-json "/api/stages/%s/%s/history/%s" pipeline stage-name offset)
         stage-instances (:stages stage-history)]
     (if (empty? stage-instances)
       []
       (let [next-offset (+ offset (count stage-instances))]
         (concat stage-instances
-                (lazy-seq (get-stage-instances pipeline stage next-offset)))))))
+                (lazy-seq (get-stage-instances pipeline stage-name next-offset)))))))

 (defn fetch-all-stage-history [pipeline stage]
   (get-stage-instances pipeline stage 0))

-(defn job-instances-for-stage [load-builds-from {stage :stage pipeline :pipeline}]
+(defn job-instances-for-stage [load-builds-from {stage-name :stage pipeline :pipeline}]
   (let [safe-build-start-date (t/minus load-builds-from (t/millis 1))]
-    (map #(assoc % :stageName stage :pipelineName pipeline)
-         (take-while #(t/after? (:scheduledDateTime %) safe-build-start-date)
-                     (mapcat job-instances-for-stage-instance
-                             (fetch-all-stage-history pipeline stage))))))
+    (->> stage-name
+         (fetch-all-stage-history pipeline)
+         (mapcat job-instances-for-stage-instance)
+         (take-while #(t/after? (:scheduledDateTime %) safe-build-start-date))
+         (map #(assoc % :stageName stage-name :pipelineName pipeline)))))

 ;; /api/pipelines/%pipelines/instance/%run


Remove resource chunking for aleph fix.

Remove resource chunking for aleph fix.

--- src/clj/cipher/main.clj
+++ src/clj/cipher/main.clj
@@ -170,14 +170,9 @@
 (defn- resources
   [req]
   (letfn [(good-response [rsrc path]
-            (let [stream (stream/stream)]
-              (async/thread
-                (doseq [b (bs/to-byte-buffers rsrc {:chunk-size 2048})]
-                  @(stream/put! stream b))
-                (stream/close! stream))
-              {:status 200
-               :body stream
-               :headers {"content-type" (mime-for path)}}))]
+            {:status 200
+             :body rsrc
+             :headers {"content-type" (mime-for path)}})]
    (let [url (io/resource (.replaceAll (str "public/" (:uri req)) "//" "/"))]
      (if (.startsWith (str url) "file")
        (let [doc (io/file url)]


* src/cljs/cljs/core.cljs: remove some yucky uses of set! since we now have IFn

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1246,12 +1246,13 @@
        (ci-reduce string f start))))

 ;;hrm
-(set! js/String.prototype.call
-      (fn
-        ([_ coll]
-           (get coll (js* "this.toString()")))
-        ([_ coll not-found]
-           (get coll (js* "this.toString()") not-found))))
+(extend-type js/String
+  IFn
+  (-invoke
+    ([_ coll]
+       (get coll (js* "this.toString()")))
+    ([_ coll not-found]
+       (get coll (js* "this.toString()") not-found))))

 (set! js/String.prototype.apply
       (fn
@@ -1998,10 +1999,11 @@

 (set! cljs.core.Vector/fromArray (fn [xs] (Vector. nil xs)))

-(set! cljs.core.Vector.prototype.call
-      (fn
-        ([_ k] (-lookup (js* "this") k))
-        ([_ k not-found] (-lookup (js* "this") k not-found))))
+(extend-type cljs.core.Vector
+  IFn
+  (-invoke
+    ([_ k] (-lookup (js* "this") k))
+    ([_ k not-found] (-lookup (js* "this") k not-found))))

 (defn vec [coll]
   (reduce conj cljs.core.Vector/EMPTY coll)) ; using [] here causes infinite recursion
@@ -2085,10 +2087,11 @@
   ([v start end]
      (Subvec. nil v start end)))

-(set! cljs.core.Subvec.prototype.call
-      (fn
-        ([_ k] (-lookup (js* "this") k))
-        ([_ k not-found] (-lookup (js* "this") k not-found))))
+(extend-type cljs.core.Subvec
+  IFn
+  (-invoke
+    ([_ k] (-lookup (js* "this") k))
+    ([_ k not-found] (-lookup (js* "this") k not-found))))

 ;;; PersistentQueue ;;;

@@ -2282,10 +2285,11 @@

 (set! cljs.core.ObjMap/fromObject (fn [ks obj] (ObjMap. nil ks obj)))

-(set! cljs.core.ObjMap.prototype.call
-      (fn
-        ([_ k] (-lookup (js* "this") k))
-        ([_ k not-found] (-lookup (js* "this") k not-found))))
+(extend-type cljs.core.ObjMap
+  IFn
+  (-invoke
+    ([_ k] (-lookup (js* "this") k))
+    ([_ k not-found] (-lookup (js* "this") k not-found))))

 ; The keys field is an array of all keys of this map, in no particular
 ; order. Each key is hashed and the result used as a property name of
@@ -2384,10 +2388,11 @@
         (recur (inc i) (assoc out (aget ks i) (aget vs i)))
         out)))))

-(set! cljs.core.HashMap.prototype.call
-      (fn
-        ([_ k] (-lookup (js* "this") k))
-        ([_ k not-found] (-lookup (js* "this") k not-found))))
+(extend-type cljs.core.HashMap
+  IFn
+  (-invoke
+    ([_ k] (-lookup (js* "this") k))
+    ([_ k not-found] (-lookup (js* "this") k not-found))))

 (defn hash-map
   "keyval => key val
@@ -2493,10 +2498,11 @@

 (set! cljs.core.Set/EMPTY (Set. nil (hash-map)))

-(set! cljs.core.Set.prototype.call
-      (fn
-        ([_ k] (-lookup (js* "this") k))
-        ([_ k not-found] (-lookup (js* "this") k not-found))))
+(extend-type cljs.core.Set
+  IFn
+  (-invoke
+    ([_ k] (-lookup (js* "this") k))
+    ([_ k not-found] (-lookup (js* "this") k not-found))))

 (defn set
   "Returns a set of the distinct elements of coll."
@@ -3438,9 +3444,9 @@
   (-get-method [mf dispatch-val])
   (-methods [mf])
   (-prefers [mf])
-  (-invoke [mf args]))
-
-(defn- do-invoke
+  (-dispatch [mf args]))
+
+(defn- do-dispatch
   [mf dispatch-fn args]
   (let [dispatch-val (apply dispatch-fn args)
         target-fn (-get-method mf dispatch-val)]
@@ -3492,16 +3498,16 @@
   (-methods [mf] @method-table)
   (-prefers [mf] @prefer-table)

-  (-invoke [mf args] (do-invoke mf dispatch-fn args))
+  (-dispatch [mf args] (do-dispatch mf dispatch-fn args))

   IHash
   (-hash [this] (goog.getUid this)))

 (set! cljs.core.MultiFn.prototype.call
-      (fn [_ & args] (-invoke (js* "this") args)))
+      (fn [_ & args] (-dispatch (js* "this") args)))

 (set! cljs.core.MultiFn.prototype.apply
-      (fn [_ args] (-invoke (js* "this") args)))
+      (fn [_ args] (-dispatch (js* "this") args)))

 (defn remove-all-methods
   "Removes all of the methods of multimethod."


CLJS-760: break apart IAtom protocol into IReset & ISwap

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -7061,8 +7061,11 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Reference Types ;;;;;;;;;;;;;;;;

-(defprotocol IAtom
+(defprotocol IReset
   (-reset! [o new-value]))
+
+(defprotocol ISwap
+  (-swap! [o f] [o f a] [o f a b] [o f a b xs]))

 (deftype Atom [state meta validator watches]
   IEquiv
@@ -7124,21 +7127,33 @@
         new-value))
     (-reset! a new-value)))

+;; generic to all refs
+;; (but currently hard-coded to atom!)
+(defn deref
+  [o]
+  (-deref o))
+
 (defn swap!
   "Atomically swaps the value of atom to be:
   (apply f current-value-of-atom args). Note that f may be called
   multiple times, and thus should be free of side effects.  Returns
   the value that was swapped in."
   ([a f]
-     (reset! a (f (.-state a))))
+     (if (instance? Atom a)
+       (reset! a (f (.-state a)))
+       (-swap! a (deref a))))
   ([a f x]
-     (reset! a (f (.-state a) x)))
+     (if (instance? Atom a)
+       (reset! a (f (.-state a) x))
+       (-swap! a (f (deref a) x))))
   ([a f x y]
-     (reset! a (f (.-state a) x y)))
-  ([a f x y z]
-     (reset! a (f (.-state a) x y z)))
-  ([a f x y z & more]
-     (reset! a (apply f (.-state a) x y z more))))
+     (if (instance? Atom a)
+       (reset! a (f (.-state a) x y))
+       (-swap! a (f (deref a) x y))))
+  ([a f x y & more]
+     (if (instance? Atom a)
+       (reset! a (apply f (.-state a) x y more))
+       (-swap! a (f (deref a) x y more)))))

 (defn compare-and-set!
   "Atomically sets the value of atom to newval if and only if the
@@ -7148,13 +7163,6 @@
   (if (= (.-state a) oldval)
     (do (reset! a newval) true)
     false))
-
-;; generic to all refs
-;; (but currently hard-coded to atom!)
-
-(defn deref
-  [o]
-  (-deref o))

 (defn set-validator!
   "Sets the validator-fn for an atom. validator-fn must be nil or a


getting result of login from channel

getting result of login from channel

--- src/cljs/ohds/core.cljs
+++ src/cljs/ohds/core.cljs
@@ -22,9 +22,9 @@

 (defn do-login [username password]
   (swap! app-state assoc :page :location)
-  (go (let [result (http/post
-                    "/api/v1/login"
-                    {:form-params {:username username :password password}})]
+  (go (let [result (<! (http/post
+                      "/api/v1/login"
+                      {:form-params {:username username :password password}}))]
         (println result)))
   (println "Logging in" username password @app-state))


Text tweaks for playability

Text tweaks for playability

--- src/game/main_game.cljs
+++ src/game/main_game.cljs
@@ -86,14 +86,14 @@
               (.. game -add (text (* 0.05 (.. game -camera -width))
                                   10
                                   "(e : interact)"
-                                  (clj->js {:font "10px Arial" :fill "grey"}))))
+                                  (clj->js {:font "12px Arial" :fill "#dddddd"}))))
         (set! (.. this -interactText -fixedToCamera) true)

         (set! (.. this -hammerText)
-              (.. game -add (text (* 0.70 (.. game -camera -width))
+              (.. game -add (text (* 0.65 (.. game -camera -width))
                                   10
                                   "(enter: pick hammer)"
-                                  (clj->js {:font "10px Arial" :fill "grey"}))))
+                                  (clj->js {:font "12px Arial" :fill "#dddddd"}))))
         (set! (.. this -hammerText -fixedToCamera) true)
         (set! (.. this -hammerText -visible) false)


also added derivative function

also added derivative function

--- src/hydrofoil/model.clj
+++ src/hydrofoil/model.clj
@@ -103,6 +103,7 @@
           (function individual x))
        resolution)))

+
 ;;;---------------- Area Functions ---------------

 (defn left-rule


remove print

remove print

--- src/cljs/swarmpit/component/service/create_image_public.cljs
+++ src/cljs/swarmpit/component/service/create_image_public.cljs
@@ -79,7 +79,6 @@
                  mixin-init-form []
   (let [{:keys [repository searching?]} (state/react form-state-cursor)
         repositories (state/react form-value-cursor)]
-    (print repositories)
     [:div.Swarmpit-image-search
      (form-repository repository)
      [:span.Swarmpit-message (str "Found " (count (:results repositories)) " repositories.")]


Log turbovote-signup create

Log turbovote-signup create


correct logic to return port number on success

--- ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/main.clj
+++ ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/main.clj
@@ -9,7 +9,7 @@
   "If the port number is valid, then returns the port itself;
    otherwise returns false."
   [port]
-  (or (< 0 port 65536) port))
+  (and (< 0 port 65536) port))

 (defn- create-shutdown-hook
   [stop-fn]


Fix media link

Fix media link

--- src/clj/chili_dog_night/data.clj
+++ src/clj/chili_dog_night/data.clj
@@ -14,7 +14,7 @@
                               "Colin Teal"
                               "Kaia"]
                   :media [{:title "The Do-Over" :uri "http://www.imdb.com/title/tt4769836/"}
-                          {:title "Gods of Egypt" :uri "http://www.imdb.com/title/tt2967224/"}]
+                          {:title "Gods of Egypt" :uri "http://www.imdb.com/title/tt2404233/"}]
                   :notes [:p
                           (el/link-to "https://en.wikipedia.org/wiki/Haller_Lake,_Seattle" "Haller Lake")
                           [:br]


Fix incorrect anchor reference

Fix incorrect anchor reference

Thanks Matt!

--- src/clj/chili_dog_night/data.clj
+++ src/clj/chili_dog_night/data.clj
@@ -113,7 +113,7 @@
                               "Greg Ryan"
                               "Jacob Dobner"]
                   :media [{:title "Nine Lives" :uri "http://www.imdb.com/title/tt4383594/"}
-                          {:title "Cell" :uri "http://www.imdb.com/title/tt2241351/"}]}
+                          {:title "Cell" :uri "http://www.imdb.com/title/tt0775440/"}]}
                  {:date "2016/11/23"
                   :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                   :synopsis "November 30th, 2016: Chili Dogs, and The Trust."


refine 404 logic

refine 404 logic

--- src/clj/clj_money/web/server.clj
+++ src/clj/clj_money/web/server.clj
@@ -22,6 +22,7 @@
             [cemerick.friend :as friend]
             [cemerick.friend.workflows :as workflows]
             [cemerick.friend.credentials :as creds]
+            [cheshire.core :as json]
             [clj-money.core]
             [clj-money.json]
             [clj-money.middleware :refer [wrap-integer-id-params
@@ -180,31 +181,35 @@
   (route GET  "/users/:token/password" users/new-password)
   (route POST "/users/:token/password" users/set-password))

+(def ^:private accept-map
+  {"application/json" :json})
+
 (defmulti render-404
   (fn [req]
     (let [accept (get (:headers req) "accept")]
-      (log/debug "accept " accept)
-      :json)))
+      (get accept-map accept :html))))

 (defmethod render-404 :json
   [req]
   {:status 404
    :headers {"Content-Type" "application/json"}
-   :body "{message: \"not found\"}"})
+   :body (json/generate-string {:message "not found"})})

 (defmethod render-404 :html
   [req]
-  (slurp (io/resource "404.html")))
+  (route/not-found (slurp (io/resource "404.html"))))

 (defroutes routes
   open-routes
   (friend/logout (POST "/logout" [] (redirect "/")))
-  (friend/wrap-authorize protected-routes #{:user})
+  (-> protected-routes
+      (friend/wrap-authorize #{:user})
+      wrap-anti-forgery)
   (friend/wrap-authorize api-routes #{:user})
   (ANY "*" req
        (do
-         (log/debug "unable to match route for " req)
-         (route/not-found (render-404 req)))))
+         (log/debug "unable to match route for " (:uri req))
+         (render-404 req))))

 (def app
   (-> routes
@@ -220,7 +225,6 @@
       wrap-json-params
       wrap-keyword-params
       wrap-json-response
-      wrap-anti-forgery
       wrap-session))

 (defn -main [& [port]]


allow updating sets

allow updating sets

--- src/clj/com/rpl/specter/impl.clj
+++ src/clj/com/rpl/specter/impl.clj
@@ -143,14 +143,7 @@
     (into [] (r/mapcat (partial next-fn vals) structure)))
   (update* [this vals structure next-fn]
     (let [ret (r/map (partial next-fn vals) structure)]
-      (cond (vector? structure)
-            (into [] ret)
-
-            (map? structure)
-            (into {} ret)
-
-            :else
-            (into '() ret)))
+      (into (empty structure) ret))
     ))

 (deftype ValStructurePath []


switch docker client to common client http setup

--- src/clj/swarmpit/docker/http.clj
+++ src/clj/swarmpit/docker/http.clj
@@ -1,17 +1,13 @@
 (ns swarmpit.docker.http
   (:refer-clojure :exclude [get])
   (:require [clj-http.conn-mgr :as conn-mgr]
-            [clj-http.client :as client]
+            [clj-http.client :as http]
+            [swarmpit.http :refer :all]
             [cheshire.core :refer [parse-string generate-string]]
-            [swarmpit.config :refer [config]]
-            [swarmpit.http :refer [with-timeout]]
-            [clojure.string :as str]
-            [clojure.tools.logging :as log])
+            [swarmpit.config :refer [config]])
   (:import (org.apache.http.config RegistryBuilder)
            (swarmpit.socket UnixSocketFactory)
-           (org.apache.http.impl.conn BasicHttpClientConnectionManager)
-           (java.io IOException)
-           (clojure.lang ExceptionInfo)))
+           (org.apache.http.impl.conn BasicHttpClientConnectionManager)))

 (defn- http?
   [] (not (nil? (re-matches #"^https?:\/\/.*" (config :docker-sock)))))
@@ -38,43 +34,25 @@
     (str server api uri)))

 (def ^:private func-map
-  {"GET"    client/get
-   "POST"   client/post
-   "PUT"    client/put
-   "DELETE" client/delete})
-
-(def timeout-ms 5000)
+  {"GET"    http/get
+   "POST"   http/post
+   "PUT"    http/put
+   "DELETE" http/delete})

 (defn execute
   "Execute docker command and parse result"
   [method uri params headers payload]
-  (try
-    (let [response (->> ((func-map method)
-                          (url uri)
-                          {:connection-manager (make-conn-manager)
-                           :headers            headers
-                           :query-params       params
-                           :body               (generate-string payload)
-                           :retry-handler      (fn [& args] false)})
-                        (with-timeout timeout-ms))
-          response-type (-> response :headers :Content-Type)]
-      (if (str/includes? (or response-type "") "text/plain")
-        (-> response :body)
-        (-> response :body (parse-string true))))
-    (catch IOException exception
-      (throw (let [error (.getMessage exception)]
-               (ex-info (str "Docker failure: " error) {:status 500
-                                                        :body   {:error error}}))))
-    (catch ExceptionInfo exception
-      (throw (let [data (some-> exception (ex-data))
-                   status (:status data)
-                   error (if (= "application/json" ((:headers data) "Content-Type"))
-                           (parse-string (:body data) true)
-                           (:reason-phrase data))]
-               (ex-info
-                 (str "Docker error: " (:message error))
-                 {:status status
-                  :body   {:error error}}))))))
+  (let [call #((func-map method)
+                (url uri)
+                {:connection-manager (make-conn-manager)
+                 :headers            headers
+                 :query-params       params
+                 :body               (generate-string payload)
+                 :retry-handler      (fn [& _] false)})]
+    (execute-in-scope {:call-fx       call
+                       :scope         "Docker client"
+                       :timeout       5000
+                       :error-handler :message})))

 (defn get
   ([uri] (get uri nil nil))


tests for John Masanori, Joshua B., NACH, Symm Visage; re-alphabetize

--- src/clj/test/cards-resources.clj
+++ src/clj/test/cards-resources.clj
@@ -1,4 +1,57 @@
 (in-ns 'test.core)
+
+(deftest daily-casts
+  "Play and tick through all turns of daily casts"
+  (do-game
+    (new-game (default-corp) (default-runner [(qty "Daily Casts" 3)]))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Daily Casts")
+    (let [dc (get-in @state [:runner :rig :resource 0])]
+      ;Number of credits
+      (is (= 8 (get-in dc [:counter])))
+      (is (= 2 (get-in @state [:runner :credit])))
+      ;End turn
+      (take-credits state :runner)
+      (take-credits state :corp)
+      (is (= 6 (get-in (refresh dc) [:counter])))
+      (is (= 7 (get-in @state [:runner :credit])))
+      (take-credits state :runner)
+      (take-credits state :corp)
+      (is (= 4 (get-in (refresh dc) [:counter])))
+      (is (= 13 (get-in @state [:runner :credit])))
+      (take-credits state :runner)
+      (take-credits state :corp)
+      (is (= 2 (get-in (refresh dc) [:counter])))
+      (is (= 19 (get-in @state [:runner :credit])))
+      (take-credits state :runner)
+      (take-credits state :corp)
+      (is (nil? (get-in @state [:runner :rig :resource 0]))))))
+
+(deftest ddos
+  "Prevent rezzing of outermost ice for the rest of the turn"
+  (do-game
+    (new-game (default-corp [(qty "Ice Wall" 3)]) (default-runner [(qty "DDoS" 1)]))
+    (play-from-hand state :corp "Ice Wall" "HQ")
+    (play-from-hand state :corp "Ice Wall" "HQ")
+    (take-credits state :corp)
+    (play-from-hand state :runner "DDoS")
+    (let [ddos (get-in @state [:runner :rig :resource 0])
+          iwall (get-in @state [:corp :servers :hq :ices 0])]
+      (card-ability state :runner ddos 0)
+      (is (= (:title ddos) (get-in @state [:runner :discard 0 :title]) ))
+      (core/click-run state :runner {:server "HQ"})
+      (core/rez state :corp iwall)
+      (is (not (get-in (refresh iwall) [:rezzed])))
+      (core/end-run state :runner)
+      (core/click-run state :runner {:server "HQ"})
+      (core/rez state :corp iwall)
+      (is (not (get-in (refresh iwall) [:rezzed])))
+      (core/end-run state :runner)
+      (take-credits state :runner)
+      (take-credits state :corp)
+      (core/click-run state :runner {:server "HQ"})
+      (core/rez state :corp iwall)
+      (is (get-in (refresh iwall) [:rezzed])))))

 (deftest film-critic-fetal-ai
   "Film Critic - Fetal AI interaction"
@@ -35,6 +88,42 @@
       (core/jack-out state :runner nil)
       (is (= 1 (:current-strength (refresh iwall))) "Ice Wall strength at 1 after encounter"))))

+(deftest john-masanori
+  "John Masanori - Draw 1 card on first successful run, take 1 tag on first unsuccessful run"
+  (do-game
+    (new-game (default-corp) (default-runner [(qty "John Masanori" 3) (qty "Sure Gamble" 3) (qty "Fall Guy" 1)]))
+    (take-credits state :corp)
+    (core/gain state :runner :click 1)
+    (play-from-hand state :runner "John Masanori")
+    (is (= 4 (count (:hand (get-runner)))))
+    (core/click-run state :runner {:server "Archives"})
+    (core/no-action state :corp nil)
+    (core/successful-run state :runner nil)
+    (is (= 5 (count (:hand (get-runner)))) "1 card drawn from first successful run")
+    (core/click-run state :runner {:server "Archives"})
+    (core/no-action state :corp nil)
+    (core/successful-run state :runner nil)
+    (is (= 5 (count (:hand (get-runner)))) "No card drawn from second successful run")
+    (core/click-run state :runner {:server "HQ"})
+    (core/jack-out state :runner nil)
+    (is (= 1 (:tag (get-runner))) "1 tag taken from first unsuccessful run")
+    (core/click-run state :runner {:server "HQ"})
+    (core/jack-out state :runner nil)
+    (is (= 1 (:tag (get-runner))) "No tag taken from second unsuccessful run")))
+
+(deftest joshua-b
+  "Joshua B. - Take 1 tag at turn end if you choose to gain the extra click"
+  (do-game
+    (new-game (default-corp) (default-runner [(qty "Joshua B." 1)]))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Joshua B.")
+    (take-credits state :runner)
+    (take-credits state :corp)
+    (prompt-choice :runner "Yes") ; gain the extra click
+    (is (= 5 (:click (get-runner))) "Gained extra click")
+    (take-credits state :runner)
+    (is (= 1 (:tag (get-runner))) "Took 1 tag")))
+
 (deftest kati-jones
   "Kati Jones - Click to store and take"
   (do-game
@@ -60,6 +149,35 @@
       (card-ability state :runner (refresh kati) 1)
       (is (= 14 (:credit (get-runner))) "Take 6cr from Kati")
       (is (zero? (:counter (refresh kati))) "No counters left on Kati"))))
+
+(deftest new-angeles-city-hall
+  "New Angeles City Hall - Avoid tags; trash when agenda is stolen"
+  (do-game
+    (new-game (default-corp [(qty "SEA Source" 1) (qty "Breaking News" 1)])
+              (default-runner [(qty "New Angeles City Hall" 1)]))
+    (play-from-hand state :corp "Breaking News" "New remote")
+    (take-credits state :corp 2)
+    (play-from-hand state :runner "New Angeles City Hall")
+    (let [nach (get-in @state [:runner :rig :resource 0])]
+      (core/click-run state :runner {:server "Archives"})
+      (core/no-action state :corp nil)
+      (core/successful-run state :runner nil)
+      (take-credits state :runner)
+      (is (= 6 (:credit (get-runner))))
+      (play-from-hand state :corp "SEA Source")
+      (prompt-choice :corp 0) ; default trace
+      (prompt-choice :runner 0) ; Runner won't match
+      (card-ability state :runner nach 0)
+      (prompt-choice :runner "Done")
+      (is (= 0 (:tag (get-runner))) "Avoided SEA Source tag")
+      (is (= 4 (:credit (get-runner))) "Paid 2 credits")
+      (take-credits state :corp)
+      (core/click-run state :runner {:server "Server 1"})
+      (core/no-action state :corp nil)
+      (core/successful-run state :runner nil)
+      (prompt-choice :runner "Steal")
+      (is (= 1 (:agenda-point (get-runner))))
+      (is (empty? (get-in @state [:runner :rig :resource])) "NACH trashed by agenda steal"))))

 (deftest security-testing
   "Security Testing - Ability"
@@ -144,7 +262,6 @@
       (prompt-card :runner (first (:hosted sp))) ; choose to install Gordian
       (is (= "Corroder" (:title (get-in @state [:runner :rig :program 0]))) "Corroder was installed")
       (is (= 3 (:memory (get-runner))) "Corroder cost 1 mu"))))
-

 (deftest street-peddler-parasite-1cr
   "Street Peddler - Installing Parasite with only 1cr. Issue #491."
@@ -169,6 +286,18 @@
       (is (= 4 (count (:discard (get-runner)))) "3 Parasite, 1 Street Peddler in heap")
       (is (= 1 (count (:discard (get-corp)))) "Pop-up Window in archives"))))

+(deftest symmetrical-visage
+  "Symmetrical Visage - Gain 1 credit the first time you click to draw each turn"
+  (do-game
+    (new-game (default-corp) (default-runner [(qty "Symmetrical Visage" 3) (qty "Sure Gamble" 3) (qty "Fall Guy" 1)]))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Symmetrical Visage")
+    (is (= 3 (:credit (get-runner))))
+    (core/click-draw state :runner nil)
+    (is (= 4 (:credit (get-runner))) "Gained 1 credit from first click spent to draw")
+    (core/click-draw state :runner nil)
+    (is (= 4 (:credit (get-runner))) "No credit gained from second click spent to draw")))
+
 (deftest the-supplier-ability
   "The Supplier - Ability"
   (do-game
@@ -248,58 +377,3 @@
       (prompt-select :runner hive)
       (is (= 2 (get (refresh hive) :counter 0)) "Hivemind gained 1 counter")
       (is (= 0 (get (refresh vbg) :counter 0)) "Virus Breeding Ground lost 1 counter"))))
-
-(deftest ddos
-  "Prevent rezzing of outermost ice for the rest of the turn"
-  (do-game
-    (new-game (default-corp [(qty "Ice Wall" 3)]) (default-runner [(qty "DDoS" 1)]))
-    (play-from-hand state :corp "Ice Wall" "HQ")
-    (play-from-hand state :corp "Ice Wall" "HQ")
-    (take-credits state :corp)
-    (play-from-hand state :runner "DDoS")
-    (let [ddos (get-in @state [:runner :rig :resource 0])
-          iwall (get-in @state [:corp :servers :hq :ices 0])]
-      (card-ability state :runner ddos 0)
-      (is (= (:title ddos) (get-in @state [:runner :discard 0 :title]) ))
-      (core/click-run state :runner {:server "HQ"})
-      (core/rez state :corp iwall)
-      (is (not (get-in (refresh iwall) [:rezzed])))
-      (core/end-run state :runner)
-      (core/click-run state :runner {:server "HQ"})
-      (core/rez state :corp iwall)
-      (is (not (get-in (refresh iwall) [:rezzed])))
-      (core/end-run state :runner)
-      (take-credits state :runner)
-      (take-credits state :corp)
-      (core/click-run state :runner {:server "HQ"})
-      (core/rez state :corp iwall)
-      (is (get-in (refresh iwall) [:rezzed]))
-      )))
-
-(deftest daily-casts
-  "Play and tick through all turns of daily casts"
-  (do-game
-    (new-game (default-corp) (default-runner [(qty "Daily Casts" 3)]))
-    (take-credits state :corp)
-    (play-from-hand state :runner "Daily Casts")
-    (let [dc (get-in @state [:runner :rig :resource 0])]
-      ;Number of credits
-      (is (= 8 (get-in dc [:counter])))
-      (is (= 2 (get-in @state [:runner :credit])))
-      ;End turn
-      (take-credits state :runner)
-      (take-credits state :corp)
-      (is (= 6 (get-in (refresh dc) [:counter])))
-      (is (= 7 (get-in @state [:runner :credit])))
-      (take-credits state :runner)
-      (take-credits state :corp)
-      (is (= 4 (get-in (refresh dc) [:counter])))
-      (is (= 13 (get-in @state [:runner :credit])))
-      (take-credits state :runner)
-      (take-credits state :corp)
-      (is (= 2 (get-in (refresh dc) [:counter])))
-      (is (= 19 (get-in @state [:runner :credit])))
-      (take-credits state :runner)
-      (take-credits state :corp)
-      (is (nil? (get-in @state [:runner :rig :resource 0])))
-      )))


refine budget end-date handling

refine budget end-date handling

--- src/clj_money/models/budgets.clj
+++ src/clj_money/models/budgets.clj
@@ -79,22 +79,39 @@
   [budget]
   (dissoc budget :items))

-(defmulti end-date
-  #(:period %))
-
-(defmethod end-date :month
-  [{:keys [start-date period-count]}]
-  (.minusDays (.plusMonths start-date period-count) 1))
-
-(defmethod end-date :week
-  [{:keys [start-date period-count]}]
-  (.minusDays (.plusWeeks start-date period-count) 1))
+(def period-map
+  {:month Months/ONE
+   :week Weeks/ONE
+   :quarter Months/THREE})
+
+(defn period-seq
+  "Returns a sequence of the periods in the budget based on
+  :start-date, :period, :period-count"
+  [budget]
+  (->> ((:period budget) period-map)
+       (periodic-seq (:start-date budget))
+       (partition 2 1)
+       (map-indexed (fn [index [start next-start]]
+                      {:start start
+                       :end (t/minus next-start Days/ONE)
+                       :index index
+                       :interval (t/interval (tc/to-date-time start)
+                                             (tc/to-date-time next-start))}))
+       (take (:period-count budget))))
+
+(defn end-date
+  [budget]
+  (-> budget
+      period-seq
+      last
+      :end
+      tc/to-local-date))

 (defn- before-save
   [budget]
   (-> budget
+      (assoc :end-date (tc/to-long (end-date budget)))
       (update-in [:start-date] tc/to-long)
-      (assoc :end-date (tc/to-long (end-date budget)))
       (update-in [:period] name)))

 (defn- period-count-must-be-greater-than-one
@@ -290,26 +307,6 @@
   (with-storage [s storage-spec]
     (delete-budget s id)))

-(def period-map
-  {:month Months/ONE
-   :week Weeks/ONE
-   :quarter Months/THREE})
-
-(defn period-seq
-  "Returns a sequence of the periods in the budget based on
-  :start-date, :period, :period-count"
-  [budget]
-  (->> ((:period budget) period-map)
-       (periodic-seq (:start-date budget))
-       (partition 2 1)
-       (map-indexed (fn [index [start next-start]]
-                      {:start start
-                       :end (t/minus next-start Days/ONE)
-                       :index index
-                       :interval (t/interval (tc/to-date-time start)
-                                             (tc/to-date-time next-start))}))
-       (take (:period-count budget))))
-
 (defn- within-period?
   "Returns a boolean value indicating whether or not
   the specified date is in the specified period"