[#2296] Refactor

[#2296] Refactor

--- backend/src/akvo/lumen/lib/user.clj
+++ backend/src/akvo/lumen/lib/user.clj
@@ -33,28 +33,30 @@
     (p/send-email emailer [email] {"Subject" "Akvo Lumen invite"
                                    "Text-part" text-part})))

-(defn create-new-account-and-invite-to-tenant
-  ""
-  [emailer keycloak tenant-conn auth-type location email
-   author-claims]
+(defn new-invitation-id [tenant-conn author-claims email]
+  (invite-id* tenant-conn author-claims email))
+
+(defn send-invitation-account-email [emailer sender-email email location invite-id tmp-password auth-type]
+  (let [text-part (selmer/render-file
+                   (format "akvo/lumen/email/%s/create_new_account_and_invite_to_tenant.txt" (name auth-type))
+                   {:author-email sender-email
+                    :email email
+                    :invite-id invite-id
+                    :location location
+                    :tmp-password tmp-password})]
+    (p/send-email emailer [email] {"Subject" "Akvo Lumen invite"
+                                   "Text-part" text-part})))
+
+(defn create-new-account [keycloak tenant-conn email]
   (let [headers (keycloak/request-headers keycloak)
         user-id (as-> (p/create-user keycloak headers email) x
                   (:headers x)
                   (get x "Location")
                   (str/split x #"/")
                   (last x))
-        tmp-password (random-url-safe-string 6)
-        invite-id (invite-id* tenant-conn author-claims email)
-         text-part (selmer/render-file
-                    (format "akvo/lumen/email/%s/create_new_account_and_invite_to_tenant.txt" (name auth-type))
-                    {:author-email (get author-claims "email")
-                     :email email
-                     :invite-id invite-id
-                     :location location
-                     :tmp-password tmp-password})]
+        tmp-password (random-url-safe-string 6)]
     (p/reset-password keycloak headers user-id tmp-password)
-    (p/send-email emailer [email] {"Subject" "Akvo Lumen invite"
-                                   "Text-part" text-part})))
+    tmp-password))

 (defn create-invite
   "First check if user is already a member of current tenant, then don't invite.
@@ -69,8 +71,10 @@
     (p/user? keycloak email) (invite-to-tenant emailer tenant-conn auth-type location email
                                        author-claims)
     :else
-    (create-new-account-and-invite-to-tenant
-     emailer keycloak tenant-conn auth-type location email author-claims))
+    (let [tmp-password (create-new-account keycloak tenant-conn email)
+          invitation-id (new-invitation-id tenant-conn author-claims email)
+          sender-email (get author-claims "email")]
+      (send-invitation-account-email emailer sender-email email location invitation-id tmp-password auth-type)))
   (lib/ok {}))

 (defn active-invites [tenant-conn]


Stream

Stream

--- src/sns_beanstalk_chat/handler.clj
+++ src/sns_beanstalk_chat/handler.clj
@@ -1,13 +1,14 @@
 (ns sns-beanstalk-chat.handler
-  (:require [compojure.core :as cj]
-            [org.httpkit.server :as http]
+  (:require [cheshire.core :as json]
+            [clojure.core.async :as async :refer [go <! >!]]
+            [clojure.java.io :as io]
             [clojure.tools.logging :as log]
+            [compojure.core :as cj]
+            [eulalie.creds]
+            [eulalie.instance-data :as instance-data]
+            [fink-nottle.sns :as sns]
             [org.httpkit.client :as http.client]
-            [clojure.core.async :as async :refer [go <! >!]]
-            [fink-nottle.sns :as sns]
-            [eulalie.instance-data :as instance-data]
-            [eulalie.creds]
-            [cheshire.core :as json])
+            [org.httpkit.server :as http])
   (:gen-class))

 (defmulti handle-sns-request
@@ -18,9 +19,12 @@
 (defmethod handle-sns-request "Message" [{:keys [body topic-chan]}]
   (async/put! topic-chan (:Message body)))

-(defn handle-topic-post [req]
+(defn handle-topic-post [{:keys [body] :as req}]
   (log/info req)
   (-> req
+      (assoc :body (-> body
+                       (io/reader :encoding "UTF-8")
+                       (json/parse-stream true)))
       (update :body json/parse-stream true)
       handle-sns-request))


CMR-3527: Modified the test.

CMR-3527: Modified the test.

--- system-int-test/test/cmr/system_int_test/search/granule_spatial_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/granule_spatial_search_test.clj
@@ -425,12 +425,8 @@
     (testing "polygon searches"
       (are [ords items]
         (let [found (search/find-refs :granule {:polygon (apply search-poly ords)
-                                                :provider "PROV1"})
-              matches? (d/refs-match? items found)]
-          (when-not matches?
-            (println "Expected:" (->> items (map :granule-ur) sort pr-str))
-            (println "Actual:" (->> found :refs (map :name) sort pr-str)))
-          matches?)
+                                                :provider "PROV1"})]
+          (d/assert-refs-match items found))
         ;; no-lr case
         [0.0 0.0, -179.9998 -89.9999, 0.0 -89.9999, 0.0 0.0]
         [no-lr]))))


Fixes barrier position when being emitted.

[ci skip]

--- src/onyx/peer/function.clj
+++ src/onyx/peer/function.clj
@@ -33,10 +33,10 @@
         barrier-gap 5]
     (loop [reader @(:onyx.core/pipeline event)
            outgoing []]
-      (cond (and (pos? (+ n-sent (count outgoing)))
+      (cond (and (seq outgoing)
                  (zero? (mod (+ n-sent (count outgoing)) barrier-gap)))
             (do (reset! (:onyx.core/pipeline event) reader)
-                (swap! (:onyx.core/n-sent-messages event) + (inc (count outgoing)))
+                (swap! (:onyx.core/n-sent-messages event) + (count outgoing))
                 {:onyx.core/batch outgoing
                  :onyx.core/barrier (->Barrier nil (:onyx.core/irnd event)
                                                (+ n-sent (count outgoing))


update core.clj to https://github.com/clojure/clojurescript/commit/c926c13f052161cb0ae161d814442f677bf013f1

--- src/main/clojure/clojure/tools/analyzer/js/cljs/core.clj
+++ src/main/clojure/clojure/tools/analyzer/js/cljs/core.clj
@@ -1596,7 +1596,8 @@
                       m)
         m           (if (meta mm-name)
                       (conj (meta mm-name) m)
-                      m)]
+                      m)
+        mm-ns (-> &env :ns :name core/str)]
     (when (= (count options) 1)
       (throw (Exception. "The syntax for defmulti has changed. Example: (defmulti name dispatch-fn :default dispatch-value)")))
     (let [options   (apply core/hash-map options)
@@ -1608,7 +1609,7 @@
                method-cache# (atom {})
                cached-hierarchy# (atom {})
                hierarchy# (get ~options :hierarchy (cljs.core/get-global-hierarchy))]
-           (cljs.core/MultiFn. ~(name mm-name) ~dispatch-fn ~default hierarchy#
+           (cljs.core/MultiFn. ~(cljs.core/symbol ~mm-ns (name mm-name)) ~dispatch-fn ~default hierarchy#
                                method-table# prefer-table# method-cache# cached-hierarchy#))))))

 (defmacro defmethod


enable the use of keywords as callback funcs in requests, so that this
succinct line works:

  @(client/get url :status)

instead of awkwardly wrapping to #(:status %)

--- src/org/httpkit/client.clj
+++ src/org/httpkit/client.clj
@@ -190,7 +190,7 @@
            "See `request` for details.")
      ~'{:arglists '([url & [opts callback]] [url & [callback]])}
      ~'[url & [s1 s2]]
-     (if (or (instance? clojure.lang.MultiFn ~'s1) (fn? ~'s1))
+     (if (or (instance? clojure.lang.MultiFn ~'s1) (fn? ~'s1) (keyword? ~'s1))
        (request {:url ~'url :method ~(keyword method)} ~'s1)
        (request (merge ~'s1 {:url ~'url :method ~(keyword method)}) ~'s2))))


remove superfluous whitespace

remove superfluous whitespace

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -90,8 +90,6 @@
                              samps))
                (recur (+ n-vals-read blen))))
            samples)))))
-
-

 (defn buffer-write!
   "Write into a section of an audio buffer which modifies the buffer in place on


Fixes #118 Setting any :no-clip? for datepicker-dropdown causes error

--- src/re_com/datepicker.cljs
+++ src/re_com/datepicker.cljs
@@ -269,10 +269,10 @@
           :as passthrough-args}]
       (let [collapse-on-select (fn [new-model]
                                  (reset! shown? false)
-                                 (when on-change (on-change new-model))) ;; wrap callback to collapse popover
-            passthrough-args   (dissoc passthrough-args :format)         ;; :format is only valid at this API level
+                                 (when on-change (on-change new-model)))    ;; wrap callback to collapse popover
+            passthrough-args   (dissoc passthrough-args :format :no-clip?)  ;; :format and :no-clip? only valid at this API level
             passthrough-args   (->> (assoc passthrough-args :on-change collapse-on-select)
-                                    (merge {:hide-border? true})         ;; apply defaults
+                                    (merge {:hide-border? true})            ;; apply defaults
                                     vec
                                     flatten)]
         [popover-anchor-wrapper


Fix indentation

Fix indentation

--- src/re_com/datepicker.cljs
+++ src/re_com/datepicker.cljs
@@ -98,13 +98,13 @@
                  :style {:padding "0px"}
                  :on-click (handler-fn (when prev-enabled? (reset! current prev-date)))}
             [:i.zmdi.zmdi-chevron-left
-             {:style    {:font-size "24px"}}]]
+             {:style {:font-size "24px"}}]]
            [:th {:class "month" :col-span "5"} (month-label @current)]
            [:th {:class (str "next " (if next-enabled? "available selectable" "disabled"))
                  :style {:padding "0px"}
                  :on-click (handler-fn (when next-enabled? (reset! current next-date)))}
             [:i.zmdi.zmdi-chevron-right
-             {:style    {:font-size "24px"}}]])
+             {:style {:font-size "24px"}}]])
      (conj template-row
            [:th {:class "day-enabled"} "SUN"]
            [:th {:class "day-enabled"} "MON"]


Evolution en cours de la logique de fonctionnement [Silver League en cours]

--- clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
+++ clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
@@ -3,12 +3,37 @@

 (defn rand-boolean [] (= (rem (rand-int 10) 2) 0))

-(defn use-boost [boost-used?] (if (not @boost-used?) (if (rand-boolean) (do (reset! boost-used? true) "BOOST") "100") "100"))
+;; Random boost using
+(defn rand-boost [boost-used?] (if (not @boost-used?) (if (rand-boolean) (do (reset! boost-used? true) "BOOST") "100") "100"))

-(defn compute-thrust [next-checkpoint-angle boost-used?]
+;; Distance entre 2 points ou norme du vecteur Norme = ||(x, y) || = sqrt(x*x+y*y)
+(defn distance [x y] (Math/sqrt (+ (* x x) (* y y))))
+;; Conversion degrés en radians :
+;; rad  = degrés * M_PI / 180
+(defn convert-degree-to-radian [degree]
+  (* degree (/ Math/PI 180) )
+  )
+
+(defn calculate-thrust-from-angle [angle] (str (Integer/valueOf (Math/round (* 100 (Math/cos (convert-degree-to-radian angle)))))))
+
+;; Ajouter le boost quand l’angle est bon et la distance assez grande
+;; Si il reste un boost
+;; Si l’angle est < 10
+;; Si la distance à la cible est > 4000
+;;Alors « BOOST »
+(defn use-boost [next-checkpoint-angle next-checkpoint-x next-checkpoint-y boost-used?]
+      (if (and (not @boost-used?) (or (< next-checkpoint-angle 10) (> next-checkpoint-angle -10)) (> (distance next-checkpoint-x next-checkpoint-y) 4000))
+          (do (reset! boost-used? true)
+              "BOOST"
+              (calculate-thrust-from-angle next-checkpoint-angle)) (calculate-thrust-from-angle next-checkpoint-angle)))
+
+(defn compute-action [next-checkpoint-angle next-checkpoint-x next-checkpoint-y boost-used?]
       (cond
-        (or (> next-checkpoint-angle 90) (< next-checkpoint-angle -90)) "0"
-         true (use-boost boost-used?)))
+        (>= (Math/abs next-checkpoint-angle) 90) "0"
+        (<= 90 (Math/abs next-checkpoint-angle)  60) "25"
+        (<= 60 (Math/abs next-checkpoint-angle)  45) "50"
+        (<= 45 (Math/abs next-checkpoint-angle)  30) "75"
+         true (use-boost next-checkpoint-angle next-checkpoint-x next-checkpoint-y boost-used?)))

 (def boost-used? (atom false))

@@ -30,5 +55,5 @@
                   (print " ")
                   (print nextCheckpointY)
                   (print " ")
-                  (print (compute-thrust (Integer/valueOf nextCheckpointAngle) boost-used?))
+                  (print (compute-action (Integer/valueOf nextCheckpointAngle) (Integer/valueOf nextCheckpointX) (Integer/valueOf nextCheckpointY) boost-used?))
                   (println ""))))


Still trying to update state

Still trying to update state

--- dashboard/src/cljs/dashboard/core.cljs
+++ dashboard/src/cljs/dashboard/core.cljs
@@ -39,24 +39,27 @@

     om/IInitState
     (init-state [_]
-                {:departments []})
-
-    om/IWillMount
-    (will-mount [_]
-                (go (while true
-                      (let [departments (<! (fetch-departments (:url opts)))]
+                (let [departments (<! (fetch-departments (:url opts)))]
                         (.log js/console (println "xx:" departments))
                         (om/transact! app :departments #(conj % departments))
-                        )
-                      (<! (timeout (:poll-interval opts)))))
-                 )
+                  {:departments departments}))
+
+
+;;    om/IWillMount
+;;   (will-mount [_]
+;;                (go (while true
+;;                      (let [departments (<! (fetch-departments (:url opts)))]
+;;                        (.log js/console (println "xx:" departments))
+;;                        (om/transact! app :departments #(conj % departments))
+;;                        )
+;;                      (<! (timeout (:poll-interval opts)))))
+;;                 )

     om/IRenderState
     (render-state [_ {:keys [departments]}]
                   (.log js/console (println "departments in app:" departments))
-                  (dom/h1 nil "Departments"))))
-
-                  ;;(om/build department-list app))
+                  (dom/h1 nil "Departments")
+                  (om/build department-list app))))

 ;;    om/IRender
 ;;    (render [_]


Change copyright year on core mac tests file.

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


Add "simple" links to each node

Add "simple" links to each node

--- src/kevin/routes/home.clj
+++ src/kevin/routes/home.clj
@@ -26,6 +26,16 @@
   (layout/common
     (form nil "Bacon, Kevin (I)")))

+(defn simple-escape [text]
+  (.. text (replace " " "+") (replace "&" "%26")))
+
+(defn- imdb-link [name type]
+  [:a {:href (str "http://imdb.com/find?exact="
+                  (= type "movie")
+                  "&q="
+                  (simple-escape name))}
+   name])
+
 (defn results [db search]
   (let [[result1 result2] search
         paths (s/find-annotated-paths db (:actor-id result1) (:actor-id result2) :limit 50)
@@ -37,7 +47,8 @@
          [:p "Bacon Number: " [:strong bacon-number]]
          (for [path paths]
            [:ul
-            (for [node path] [:li {:class (:type node)} (:name node)])])]
+            (for [node path] [:li {:class (:type node)}
+                              (imdb-link (:name node) (:type node))])])]
         [:p "Not linkable in 5 hops or fewer"]))))

 (defn disambiguate [search]


Remove GentleLinkedBlockingQueue from acq engine and use a 10-node LinkedBlockingQueue

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -38,8 +38,8 @@
            [mmcorej TaggedImage Configuration Metadata]
            [java.util.prefs Preferences]
            [java.net InetAddress]
-           [java.util.concurrent TimeUnit CountDownLatch]
-           [org.micromanager.utils GentleLinkedBlockingQueue MDUtils
+           [java.util.concurrent LinkedBlockingQueue TimeUnit CountDownLatch]
+           [org.micromanager.utils MDUtils
                                    ReportingUtils]
            [org.json JSONObject JSONArray]
            [java.util Date UUID]
@@ -738,7 +738,7 @@
   (def eng acq-eng)
   (load-mm)
   (swap! (.state this) assoc :stop false :pause false :finished false)
-  (let [out-queue (GentleLinkedBlockingQueue.)
+  (let [out-queue (LinkedBlockingQueue. 10)
         settings (convert-settings acq-settings)
         summary-metadata (make-summary-metadata settings)]
     (reset! (.state this) nil)


default stage position

default stage position

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -99,6 +99,7 @@
 (declare interrupt-requests)
 (declare z-corrections)
 (declare init-auto-shutter)
+(declare default-z-position)

 ;; metadata

@@ -238,7 +239,7 @@
 				(+ (or (get-in event [:channel :z-offset]) 0)
 				   (or (get @z-corrections z-drive)
 				     (:slice event)
-				     (get-z-stage-position z-drive))))
+				     default-z-position)))
       (assoc-in [:postion :axes z-drive] nil))
     event))

@@ -273,7 +274,8 @@
             z-corrections (ref nil)
             last-wake-time (atom (clock-ms))
             start-time (clock-ms)
-            init-auto-shutter (. mmc getAutoShutter)]
+            init-auto-shutter (. mmc getAutoShutter)
+            default-z-position (get-z-position (. mmc getFocusDevice))]
     (let [acq-seq (generate-acq-sequence settings)]
        (def acq-sequence acq-seq)
        (execute (mapcat #(make-event-fns % out-queue) acq-seq))


If autofocus fails, retry, and if that fails as well, then ignore it.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -215,6 +215,11 @@
     (let [xy (.getXYStagePosition gui)]
       [(.x xy) (.y xy)])))

+(defn enable-continuous-focus [on?]
+  (let [autofocus (core getAutoFocusDevice)]
+    (device-best-effort autofocus
+                        (core enableContinuousFocus on?))))
+
 (defn set-shutter-open [open?]
   (let [shutter (core getShutterDevice)]
     (device-best-effort shutter
@@ -226,7 +231,7 @@
   (when (and (@state :init-continuous-focus)
              (not (core isContinuousFocusDrive stage))
              (core isContinuousFocusEnabled))
-    (core enableContinuousFocus false))
+    (enable-continuous-focus false))
   (device-best-effort stage (core setPosition stage pos)))

 (defn set-stage-position
@@ -428,7 +433,7 @@
   (log "acq-sleep")
   (when (and (@state :init-continuous-focus)
              (not (core isContinuousFocusEnabled)))
-    (core enableContinuousFocus true))
+    (try (core enable-continuous-focus true) (catch Throwable t nil))) ; don't quit if this fails
   (let [target-time (+ (@state :last-wake-time) interval-ms)
         delta (- target-time (jvm-time-ms))]
      (when (and (< 1000 delta)
@@ -558,7 +563,7 @@
         (set-shutter-open state))
       (when (and (@state :init-continuous-focus)
                  (not (core isContinuousFocusEnabled)))
-        (core enableContinuousFocus true))
+        (core enable-continuous-focus true))
       (return-config)
       (. gui enableRoiButtons true))
     (catch Throwable t (ReportingUtils/showError t "Acquisition cleanup failed."))))


tightening

tightening

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -159,18 +159,15 @@
      "NUL"
      "/dev/null")))

-(defn- compile-status [status msg]
+(defn- status [status msg]
   (do
     (binding [*out* (if status *out* *err*)]
       (when-not *silently*
         (println msg)))
     status))

-(def ^{:private true}
-     success (partial compile-status true))
-
-(def ^{:private true}
-     failure (partial compile-status false))
+(def ^{:private true} success (partial status true))
+(def ^{:private true} failure (partial status false))

 (defn compile
   "Ahead-of-time compile the namespaces given under :aot in project.clj or


Remove a console.log

Remove a console.log

--- src/tabswitcher/popup.cljs
+++ src/tabswitcher/popup.cljs
@@ -20,8 +20,7 @@
       (>! bg [:tabs])
       (let [tabs (<! bg)]
         (dispatch [:assign-bg-chan bg])
-        (dispatch [:update tabs])
-        (console/log tabs))))
+        (dispatch [:update tabs]))))

   (r/render-component [views/app]
                       (.getElementById js/document "app")))


better import interaction

better import interaction

--- src/tango/cljs/client.cljs
+++ src/tango/cljs/client.cljs
@@ -40,7 +40,8 @@
 (defn init-app []
   (d/transact! conn [{:db/id -1 :app/id 1}
                      {:db/id -1 :selected-page :competitions}
-                     ;{:db/id -1 :app/selected-competition {}}
+                     {:db/id -1 :app/import-status :none}
+                     {:db/id -1 :app/selected-competition {}}
                      ]))

 (defn app-started? [conn]
@@ -56,19 +57,22 @@

 (declare reconciler)
 (defn handle-query-result [d]
-  (log "Handle Q R")
+  (do
+    (log "Handle Q R")
     ;; VERY TEMPORARY (KILL ME IF I DO NOT FIX IT)
     ;; Need to make difference between query for all comps. vs query for details for a comp.
-
-  (if (vector? d)
-    (let [clean-data  {:competitions d}      ;(uidb/sanitize (first d))
-          ]
-      (log "Compsss")
-      (om/transact! reconciler `[(app/add-competition ~clean-data) :app/competitions])
-      )
-    (let [clean-data (uidb/sanitize d)]
-      (log "Crazzzy")
-      (om/transact! reconciler `[(app/add-competition ~clean-data) :app/competitions]))))
+
+    (if (vector? d)
+      (let [clean-data  {:competitions d}      ;(uidb/sanitize (first d))
+            ]
+        (log "Compsss")
+        (om/transact! reconciler `[(app/add-competition ~clean-data) :app/competitions])
+        )
+      (let [clean-data (uidb/sanitize d)]
+        (log "Crazzzy")
+        (om/transact! reconciler `[(app/add-competition ~clean-data) :app/competitions])))
+    (om/transact! reconciler `[(app/set-import-status {:status :none})]))
+  )

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Sente message handling
@@ -182,6 +186,16 @@
               ;(log q)
               q))})

+(defmethod read :app/import-status
+  [{:keys [state query]} key params]
+  {:value (do
+            (log "Read Import status")
+            (let [q (d/q '[:find ?status .
+                           :where [[:app/id 1] :app/import-status ?status]]
+                         (d/db state))]
+              (log q)
+              q))})
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Mutate

@@ -210,6 +224,12 @@
                  (d/transact! state [{:app/id 1 :selected-page page}])
                  ;(log state)
                  ))})
+
+(defmethod mutate 'app/set-import-status
+  [{:keys [state]} key {:keys [status] :as params}]
+  {:value {:keys [:app/import-status]}
+   :action (fn []
+             (d/transact! state [{:app/id 1 :app/import-status status}]))})

 (defmethod mutate 'app/select-competition
   [{:keys [state]} key {:keys [name]}]
@@ -353,9 +373,12 @@
          name (:competition/name competition)]
      (dom/tr
       ;; TODO - this should be handle be some remote mechanism
+      ;; TODO - set app status to remote query then reset at query done
       #js {:onClick #(do
                        (chsk-send! [:event-manager/query ['[*] [:competition/name name]]])
-                       (om/transact! this `[(app/select-competition {:name ~name})]))}
+                       (om/transact! this `[(app/select-competition {:name ~name})])
+                       ;(om/transact! this `[(app/select-competition {:name {}})])
+                       )}
       (dom/td nil name)
       (dom/td nil (:competition/location competition))))))

@@ -365,14 +388,18 @@
   Object
   (render
    [this]
-   (let [competitions (om/props this)]
+   (let [competitions (:competitions (om/props this))
+         status (:status (om/props this))]
      (log "Render CompetitionView")
      (log (om/props this))
+     (log "Import Status")
+      (log status)
      (dom/div
       nil
       (dom/h2
        nil
        "Mina tävlingar")
+      (dom/span nil "Välj en tävling att arbete med.")
       (dom/table
        #js {:className "table table-hover"}
        (dom/thead
@@ -382,12 +409,19 @@
          (dom/th nil "Namn")
          (dom/th nil "Plats")))
        (apply dom/tbody nil (map competition competitions)))
-

       (dom/div
        nil
-       (dom/span #js {:className "btn btn-default btn-file"} "Importera.."
-                 (dom/input #js {:type "file" :onChange #(on-click-import-file %)})))))))
+       (dom/span #js {:className (str "btn btn-default btn-file"
+                                      (when (= status :importing) " disabled"))} "Importera.."
+                 (dom/input #js {:type "file"
+                                 :onChange #(do
+                                              (om/transact! reconciler `[(app/set-import-status
+                                                                          {:status :importing})])
+                                              (on-click-import-file %))}))
+       (condp = status
+         :none (dom/h3 nil "")
+         :importing (dom/h3 nil "Importerar, vänligen vänta..")))))))

 ;;;;;;;;;;;;;;;;;;;;
 ;; Classes
@@ -533,6 +567,7 @@
   static om/IQuery
   (query [this]
          [:app/selected-page
+          :app/import-status
           {:app/competitions (om/get-query Competition)}
           {:app/selected-competition
            (concat (om/get-query ClassesView)
@@ -569,26 +604,11 @@
                                  (dom/form #js {:className "navbar-form navbar-right"}
                                            (dom/input #js {:type "text"
                                                            :className "form-control"
-                                                           :placeholder "Search..."}))
-                                 ;; (dom/div nil (make-button "Tävlingar" :competitions)
-                                 ;;          (dom/button
-                                 ;;           #js {:onClick
-                                 ;;                (fn [e]
-                                 ;;                  (test-query-click this))}
-                                 ;;           "Query")
-                                 ;;          (when selected-competition
-                                 ;;            (apply dom/div nil
-                                 ;;                   (map (fn [[name key]] (make-button name key))
-                                 ;;                        [["Properties" :properties]
-                                 ;;                         ["Classes" :classes]
-                                 ;;                         ["Time Schedule" :schedule]
-                                 ;;                         ["Adjudicators" :adjudicators]
-                                 ;;                         ["Adjudicator Panels" :adjudicator-panels]]))))
-                                 )))
+                                                           :placeholder "Search..."})))))

       (dom/div #js {:className "container-fluid"}
                (dom/div #js {:className "row"}
-                        (when selected-competition
+                        (when (not (empty? selected-competition))
                           (dom/div #js {:className "col-sm-2 col-md-2 sidebar"}
                                    (dom/div nil (dom/u nil (:competition/name selected-competition)) )
                                    (apply dom/ul #js {:className "nav nav-sidebar"}
@@ -597,19 +617,17 @@
                                                 ["Classes" :classes]
                                                 ["Time Schedule" :schedule]
                                                 ["Adjudicators" :adjudicators]
-                                                ["Adjudicator Panels" :adjudicator-panels]]))
-                                   ;; (dom/li #js {:className "active"
-                                   ;;              :onClick  #(log "click")}
-                                   ;;         (dom/a {:href "#"} "Classer"))
-                                   ;; (dom/li nil (dom/a {:href "#"} "Time Schedule"))
-                                   ))
+                                                ["Adjudicator Panels" :adjudicator-panels]]))))

                         (dom/div #js {:className "col-sm-10 col-sm-offset-2 col-md-10 col-md-offset-2 main"}
                                  ;(dom/h1 #js {:className "page-header"} "Rikstävling yada yada")
                                  (condp = spage
                                    :properties ((om/factory PropertiesView) selected-competition)
                                    :classes ((om/factory ClassesView) selected-competition)
-                                   :competitions ((om/factory CompetitionsView) competitions)
+                                   :competitions ((om/factory CompetitionsView)
+                                                  {:competitions competitions
+                                                   :status (:app/import-status (om/props this))
+                                                   })
                                    :schedule ((om/factory ScheduleView) selected-competition)
                                    :adjudicators ((om/factory AdjudicatorsView) selected-competition)
                                    :adjudicator-panels ((om/factory AdjudicatorPanelsView) selected-competition)))))))))


Whitespace cleanup

Whitespace cleanup

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/core.clj
+++ src/obcc/core.clj
@@ -25,7 +25,7 @@
   {"deps",    ["Resolve dependencies",                 depscmd/run],
    "build",   ["Build the chaincode project",          buildcmd/run],
    "package", ["Package the chaincode for deployment", packagecmd/run]})
-
+
 (defn usage [options-summary]
   (->> (flatten ["Usage: obcc [options] action"
         ""


Upgrade drake

Upgrade drake

--- src/qu/loader.clj
+++ src/qu/loader.clj
@@ -39,7 +39,10 @@
   "Run all tasks in a Drakefile."
   [drakefile]
   (log/info "Running Drakefile" drakefile)
-  (drake/run-workflow drakefile :targetv ["=..."]))
+  (let [options (apply concat
+                       (merge drake/DEFAULT-OPTIONS
+                              {:targetv ["=..."]}))]
+    (apply drake/run-workflow drakefile options)))

 (defn- slice-type-for-table-type
   "The types for transforming data from the strings in the CSV file


add and upt mutation forms functionality is changed

--- src_cljs/rrm/corecljs.cljs
+++ src_cljs/rrm/corecljs.cljs
@@ -475,7 +475,30 @@
   (secretary/dispatch! "/"))

-(defn mutation-template [doc-name data-set focus save-function]
+
+(defn form-input-check-element [id label ttype data-set focus]
+  (let [input-focus (r/atom nil)
+        check (r/atom true)]
+    (fn []
+      (if (id @data-set)
+        [:div.form-group
+         [:label.col-sm-3.control-label label]
+         [:div.col-sm-6 [input-element id ttype data-set label input-focus]]
+         [:div.col-sm-3 [:div]]]
+        [:div.form-group
+         [:div.col-sm-1
+          [:input {:type "checkbox"
+                   :style {:width "17px" :height "17px" :float "right"}
+                   :on-change #(swap! check not)}]]
+         [:label.col-sm-2.control-label label]
+         [:div.col-sm-6
+          (if @check
+            [:div]
+            [input-element id ttype data-set label input-focus])]
+         [:div.col-sm-3 [:div]]]
+        ))))
+
+(defn add-mutation-template [doc-name data-set focus save-function]
   [:div.container
    [:div.col-md-12
     [:div.box.box-info
@@ -500,14 +523,53 @@
        [form-input-element :o4number "O4 Number" "text" data-set focus]
        [form-input-element :o6number "O6 Number" "text" data-set focus]
        [form-input-element :racknumber "Rack Number" "text" data-set focus]
-       [form-input-element :senddate "Send Date" "date" data-set focus]
-       [form-input-element :receiveddate "Received Date" "date" data-set focus]
-       [form-input-element :remarks "Remarks" "text" data-set focus]]
+       [form-input-check-element :senddate "Send Date" "date" data-set focus]
+       [form-input-element :remarks "Remarks" "text" data-set focus]
+       ]
       [:div.box-footer
        [:button.btn.btn-default {:on-click form-cancel} "Cancel"]
        [:button.btn.btn-info.pull-right {:on-click save-function} "Save"]
        ;;[:span (str @data-set)]
        ]]]]])
+
+
+
+
+(defn update-mutation-template [doc-name data-set focus save-function]
+  [:div.container
+   [:div.col-md-12
+    [:div.box.box-info
+     [:div.box-header.with-border
+      [:h2.box-title doc-name]]
+     [:div.form-horizontal
+      [:div.box-body
+       [form-input-element :mutationnumber "Mutation Number" "text" data-set focus]
+       [form-input-element :nameofthefirstparty "Name of the First Party" "text" data-set focus ]
+       [form-input-element :nameofthesecondparty "Name of the Second Party" "text" data-set focus]
+       [form-input-element :dateofinstitution "Date of Institution" "date" data-set focus]
+       [form-input-combo   :nameofpo "Name of PO" data-set focus]
+       [form-input-element :dateofdecision "Date of Decision" "date" data-set focus]
+       [form-input-element :title "Title" "text" data-set focus]
+       [form-input-element :khasranumber "Khasra Number" "text" data-set focus]
+       [form-input-element :area "Area" "text" data-set focus]
+       [form-input-element :khatakhatuninumber "Khata Khatuni Number" "text" data-set focus]
+       [form-dist-sel "District" :districtid (:districts @storage) data-set]
+       [form-sub-sel "Sub-division Name" :subdivisionid (:subdivisions @storage) data-set]
+       [form-villages-sel "Village Name" :villageid (:villages @storage) data-set]
+       [form-input-element :o2number "O2 Number" "text" data-set focus]
+       [form-input-element :o4number "O4 Number" "text" data-set focus]
+       [form-input-element :o6number "O6 Number" "text" data-set focus]
+       [form-input-element :racknumber "Rack Number" "text" data-set focus]
+       [form-input-check-element :senddate "Send Date" "date" data-set focus]
+       [form-input-check-element :receiveddate "Received Date" "date" data-set focus]
+       [form-input-element :remarks "Remarks" "text" data-set focus]
+       ]
+      [:div.box-footer
+       [:button.btn.btn-default {:on-click form-cancel} "Cancel"]
+       [:button.btn.btn-info.pull-right {:on-click save-function} "Save"]
+       ;;[:span (str @data-set)]
+       ]]]]])
+

 (defn map-mutation-data [mut]
   {:id (if (nil? (mut :id))0 (int (mut :id))) :nameofthefirstparty (mut :nameofthefirstparty)
@@ -544,7 +606,7 @@
 (defn mutation-add-template []
   (let [add-data (r/atom {:isactive true})
         focus (r/atom nil)]
-    (fn [] [mutation-template "Mutation Add Form" add-data focus #(add-form-onclick add-data focus)])))
+    (fn [] [add-mutation-template "Mutation Add Form" add-data focus #(add-form-onclick add-data focus)])))

 (defn mutation-update-template [id dmt]
@@ -571,7 +633,7 @@
                              :districtid (.-id (.-district dmt))
                              :isactive true})
         focus (r/atom nil)]
-    (fn [] [mutation-template
+    (fn [] [update-mutation-template
            "Mutation Update Form"
            update-data
            focus


[#148] Avoid NPE on failed compile

[#148] Avoid NPE on failed compile

This change also logs the namespace which fails to compile.

--- clojurephant-tools/src/main/clojure/dev/clojurephant/tools/clojure_compiler.clj
+++ clojurephant-tools/src/main/clojure/dev/clojurephant/tools/clojure_compiler.clj
@@ -7,16 +7,17 @@
 (defn -main [& args]
   (log :debug "Classpath: %s" (System/getProperty "java.class.path"))
   (let [[destination-dir namespaces options] (edn/read)]
-    (try
-      (binding [*namespaces* (seq namespaces)
-                *compile-path* destination-dir
-                *compiler-options* options]
-        (doseq [namespace namespaces]
+    (binding [*namespaces* (seq namespaces)
+              *compile-path* destination-dir
+              *compiler-options* options]
+      (doseq [namespace namespaces]
+        (try
           (log :info "Compiling %s" namespace)
-          (compile (symbol namespace))))
-      (catch Throwable e
-        (loop [ex e]
-          (if-let [msg (and ex (.getMessage ex))]
-            (log :error msg)
-            (recur (.getCause ex))))
-        (throw e)))))
+          (compile (symbol namespace))
+          (catch Throwable e
+            (loop [ex e]
+              (when-let [msg (and ex (.getMessage ex))]
+                (log :error "Failed to compile %s" namespace)
+                (log :error msg))
+              (when ex (recur (.getCause ex))))
+            (throw e)))))))


CMR-1418: Adding test for searching across all revisions by revision date.

--- system-int-test/test/cmr/system_int_test/search/rev_date_concept_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/rev_date_concept_search_test.clj
@@ -26,8 +26,21 @@
           coll2 (d/ingest "PROV1" (dc/collection {}))
           _ (dev-sys-util/freeze-time! "2000-03-01T10:00:00Z")
           coll3 (d/ingest "PROV1" (dc/collection {}))
+
+          ;; Collection 4 will have updates
           _ (dev-sys-util/freeze-time! "2000-04-01T10:00:00Z")
-          coll4 (d/ingest "PROV1" (dc/collection {}))
+          coll4-1 (d/ingest "PROV1" (dc/collection {}))
+          _ (dev-sys-util/freeze-time! "2000-05-01T10:00:00Z")
+          coll4-2 (d/ingest "PROV1" (dissoc coll4-1 :revision-id))
+
+          ;; Collection D will be deleted
+          _ (dev-sys-util/freeze-time! "2000-06-01T10:00:00Z")
+          coll-d-1 (d/ingest "PROV1" (dc/collection {}))
+
+          _ (dev-sys-util/freeze-time! "2000-07-01T10:00:00Z")
+          _ (ingest/delete-concept (d/item->concept coll-d-1))
+          coll-d-2 (assoc coll-d-1 :deleted true :revision-id 2)
+
           _ (dev-sys-util/freeze-time! "2015-01-01T10:00:00Z")
           coll5 (d/ingest "PROV1" (dc/collection {}))]
       (index/wait-until-indexed)
@@ -39,39 +52,64 @@
                   (d/refs-match? colls references))

                 "range without begin - find all"
-                [coll1 coll2 coll3 coll4 coll5] ",2015-01-01T10:00:00Z" {}
+                [coll1 coll2 coll3 coll4-2 coll5] ",2015-01-01T10:00:00Z" {}
+
+                "all-revisions - range without begin - find all"
+                [coll1 coll2 coll3 coll4-1 coll4-2 coll-d-1 coll-d-2 coll5] ",2015-01-01T10:00:00Z" {:all-revisions true}
+
                 "range without begin - find some"
                 [coll1 coll2 coll3] ",2000-03-01T10:00:00Z" {}
+
+                "all-revisions - range without begin - find some"
+                [coll1 coll2 coll3 coll4-1 coll4-2] ",2000-05-01T10:00:00Z" {:all-revisions true}
+
                 "range without begin - find none"
                 [] ",2000-01-01T09:00:00Z" {}
+
                 "range without end - find all"
-                [coll1 coll2 coll3 coll4 coll5] "2000-01-01T10:00:00Z," {}
+                [coll1 coll2 coll3 coll4-2 coll5] "2000-01-01T10:00:00Z," {}
+
                 "range without end - omitting ,"
-                [coll1 coll2 coll3 coll4 coll5] "2000-01-01T10:00:00Z" {}
+                [coll1 coll2 coll3 coll4-2 coll5] "2000-01-01T10:00:00Z" {}
+
                 "range without end - find some"
-                [coll4 coll5] "2000-04-01T10:00:00Z," {}
+                [coll4-2 coll5] "2000-04-01T10:00:00Z," {}
+
+                "all-revisions - range without end - find some"
+                [coll4-1 coll4-2 coll-d-1 coll-d-2 coll5] "2000-04-01T10:00:00Z," {:all-revisions true}
+
                 "range without end - find none"
                 [] "2015-01-01T11:00:00Z," {}
+
                 "range - find all"
-                [coll1 coll2 coll3 coll4 coll5] "2000-01-01T10:00:00Z,2015-01-01T10:00:00Z" {}
+                [coll1 coll2 coll3 coll4-2 coll5] "2000-01-01T10:00:00Z,2015-01-01T10:00:00Z" {}
+
                 "range - find some"
                 [coll1 coll2] "2000-01-01T10:00:00Z,2000-02-01T10:00:00Z" {}
+
                 "range - find none"
                 [] "2000-01-01T11:00:00Z,2000-02-01T09:00:00Z" {}
+
                 "find a single value"
                 [coll1] "2000-01-01T10:00:00Z,2000-01-01T10:00:00Z" {}
+
                 "multiple ranges without options, should default to AND false"
-                [coll3 coll4 coll5] ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"] {}
+                [coll3 coll4-2 coll5] ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"] {}
+
                 "multiple ranges with option and false"
-                [coll3 coll4 coll5] ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"] {"options[revision_date][and]" "false"}
+                [coll3 coll4-2 coll5] ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"] {"options[revision_date][and]" "false"}
+
                 "multiple ranges with option and true"
-                [coll4] ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"] {"options[revision_date][and]" "true"}))
+                [coll4-2] ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"] {"options[revision_date][and]" "true"}))
+
+
       (testing "search collections with revision_date is OK"
         (are [colls param value]
              (let [references (search/find-refs :collection {param value})]
                (d/refs-match? colls references))
              [coll1 coll2] "revision_date[]" "2000-01-01T10:00:00Z,2000-02-01T10:00:00Z"
-             [coll3 coll4 coll5] "revision_date" ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"]))
+             [coll3 coll4-2 coll5] "revision_date" ["2000-04-01T10:00:00Z," "2000-03-01T10:00:00Z,2000-05-01T10:00:00Z"]))
+
       (testing "search collections with invalid revision date"
         (u/are2 [value err-pattern]
                 (let [{:keys [status errors]} (search/find-refs :collection {"revision_date" value})
@@ -92,9 +130,9 @@
         (are [colls param value]
              (let [references (search/find-refs :collection {param value})]
                (d/refs-match? colls references))
-             [coll1 coll2 coll3 coll4 coll5] "updated_since" "2000-01-01T10:00:00Z"
-             [coll1 coll2 coll3 coll4 coll5] "updated_since[]" "2000-01-01T10:00:00Z"
-             [coll2 coll3 coll4 coll5] "updated_since" "2000-02-01T00:00:00Z"
+             [coll1 coll2 coll3 coll4-2 coll5] "updated_since" "2000-01-01T10:00:00Z"
+             [coll1 coll2 coll3 coll4-2 coll5] "updated_since[]" "2000-01-01T10:00:00Z"
+             [coll2 coll3 coll4-2 coll5] "updated_since" "2000-02-01T00:00:00Z"
              [coll5] "updated_since" "2015-01-01T10:00:00Z"
              [] "updated_since" "2015-01-01T10:00:01Z"))
       (testing "search collections with updated_since range is invalid"
@@ -109,8 +147,8 @@
       (testing "search collections with multiple updated_since values is invalid"
         (let [value ["2000-01-01T10:00:00Z" "2009-01-01T10:00:00Z"]
               {:keys [status errors]} (search/find-refs :collection {"updated_since" value})]
-                  (is (= [400 ["Search not allowed with multiple updated_since values"]]
-                        [status errors])))))))
+          (is (= [400 ["Search not allowed with multiple updated_since values"]]
+                 [status errors])))))))

 (deftest search-granules-by-revision-date


Korjattu access login namespace

Korjattu access login namespace

--- clj-log/src/clj_log/access_log.clj
+++ clj-log/src/clj_log/access_log.clj
@@ -6,7 +6,7 @@

 (declare service)

-(def ^{:private true} logger (impl/get-logger (impl/find-factory) "access-log"))
+(def ^{:private true} logger (impl/get-logger (impl/find-factory) "ACCESS"))

 (defn parse-access-headers [start request response]
       (let [duration (- (System/currentTimeMillis) start)


Allow quoting of maps for bodies

Allow quoting of maps for bodies

--- src/yada/body.clj
+++ src/yada/body.clj
@@ -38,6 +38,16 @@
               {:encoding (or (some-> representation :charset charset/charset)
                              charset/default-platform-charset)}))

+(defrecord MapBody [map])
+
+(defn as-body
+  "The equivalent of 'quoting' an actual map inside a resource as an
+  actual body. Otherwise maps can be treated as a nested value, as
+  part of the resource itself. This is the case when using the
+  shorthand {:get map} form, rather than {:get {:"
+  [map]
+  (->MapBody map))
+
 (extend-protocol MessageBody

   String
@@ -50,6 +60,10 @@
   ;; See  http://mark.koli.ch/remember-kids-an-http-content-length-is-the-number-of-bytes-not-the-number-of-characters
   (content-length [s]
     nil)
+
+  MapBody
+  (to-body [mb representation]
+    (to-body (:map mb) representation))

   clojure.lang.APersistentMap
   (to-body [m representation]


(maint) Add tests which exercise validate-regex-backreferences!

This commit adds two tests which exercise validate-regex-backreferences!
using allow with a map containing a certname with backreferences.

--- test/puppetlabs/trapperkeeper/services/authorization/authorization_core_test.clj
+++ test/puppetlabs/trapperkeeper/services/authorization/authorization_core_test.clj
@@ -226,6 +226,15 @@
              :name "base-regex-auth"})))

     (is (thrown-with-msg?
+         IllegalArgumentException
+         #"contains the back reference '\$1' which refers to a capture group in the regex that doesn't exist."
+         (validate-auth-config-rule!
+          {:match-request {:path "/some/thing" :type "regex"}
+           :allow {:certname "$1"}
+           :sort-order 500
+           :name "base-regex-auth"})))
+
+    (is (thrown-with-msg?
           IllegalArgumentException
           #"contains the back reference '\$2' which refers to a capture group in the regex that doesn't exist."
           (validate-auth-config-rule!
@@ -233,6 +242,15 @@
              :allow "$1$2"
              :sort-order 500
              :name "base-regex-auth"})))
+
+    (is (thrown-with-msg?
+         IllegalArgumentException
+         #"contains the back reference '\$2' which refers to a capture group in the regex that doesn't exist."
+         (validate-auth-config-rule!
+          {:match-request {:path "/some/(thing)" :type "regex"}
+           :allow ["foo" {:certname "$1$2"}]
+           :sort-order 500
+           :name "base-regex-auth"})))

     (is (thrown-with-msg?
           IllegalArgumentException


tropefest.parsing clean-up

tropefest.parsing clean-up

--- src/tropefest/parsing.clj
+++ src/tropefest/parsing.clj
@@ -8,13 +8,10 @@

 (defn load-resource-url [url]
+  "Loads a html-resource from a URL."
   (-> url URI. e/html-resource))

 ; (def sample-res (load-resource-url "http://tvtropes.org/pmwiki/pmwiki.php/Anime/CowboyBebop"))
-
-
-(def base-path "/pmwiki/pmwiki.php/")
-(def base-url (str "http://tvtropes.org" base-path))

 (defn content-from-meta
   "Receives a html-resource and returns the content attribute of a meta type indexed by a property."
@@ -22,13 +19,11 @@
   (-> (e/select res [[:meta (e/attr= :property property)]]) first (get-in [:attrs :content])))

 (defn label-from-id
-  "Returns the node label from a node id. Node id is expected to be of the
-  form Category/SubCategory.
+  "Returns the node label from a node id, which is expected to be of the form Category/SubCategory.

-  Previously I used the og-type as the node label, but a lot of them are too
-  generic. For instance, 'article' is used both for the main trope articles as
-  well as for the articles on different genres, whereas the root is more
-  specific to the topic at hand.
+  Previously I used the og-type as the node label, but a lot of them are too generic.
+  For instance, 'article' is used both for the main trope articles as well as for the
+  articles on different genres, whereas the root is more specific to the topic at hand.

   As an example:

@@ -39,36 +34,42 @@
   [^String id]
   (-> id (s/split #"/") first (ut/if-empty "Unknown")))

+
+; Attributes to parse:
+; og:url - Base url
+; og:type - article type. Will be something like video.tv_show, we should probably capitalize it.  (split "video.tv_show" #"\.")
+; og:title - Article title
+;
+; Root article URL: http://tvtropes.org/pmwiki/pmwiki.php/
+; The identifier would be path-of minus /pmwiki/pmwiki.php/
+
+(def base-path "/pmwiki/pmwiki.php/")
+(def base-url (str "http://tvtropes.org" base-path))
+
+
 (defn node-data-from-meta
   "Returns the relevant metadata of a html-resource as a map, including things
   we care about like the node label."
   [res]
   (let [og-url (content-from-meta res "og:url")
-        og-host (ut/host-string-of og-url)
-        og-title (content-from-meta res "og:title")
-        og-image (content-from-meta res "og:image")
-        og-type (-> (content-from-meta res "og:type") (ut/if-nil ""))
-        id (-> (u/path-of og-url) (s/replace base-path ""))
-        label (label-from-id id)]
-    {:url   og-url
-     :host  og-host
-     :title og-title
-     :image og-image
-     :type  og-type
-     :id    id
-     :label label}))
+        id (-> (u/path-of og-url) (s/replace base-path ""))]
+    {:id    id
+     :url   og-url
+     :host  (ut/host-string-of og-url)
+     :title (content-from-meta res "og:title")
+     :image (content-from-meta res "og:image")
+     :type  (-> (content-from-meta res "og:type") (ut/if-nil ""))
+     :label (label-from-id id)}))

 (defn node-data-from-url
   "Returns a map with the metadata we can infer about a new from its URL.
   Assumes the url string conforms to the defined base-url, or will return nil."
   [^String url]
   (if (.startsWith url base-url)
-    (let [og-host (ut/host-string-of url)
-          id (-> (u/path-of url) (s/replace base-path ""))
-          label (label-from-id id)]
-      {:label label
+    (let [id (-> (u/path-of url) (s/replace base-path ""))]
+      {:label (label-from-id id)
        :id    id
-       :host  og-host
+       :host  (ut/host-string-of url)
        :url   url})
     nil))

@@ -97,14 +98,4 @@
       (get-wiki-links res (:host meta))
       (pmap node-data-from-url)
       (pmap #(db/create-or-merge-node conn %))
-      (pmap #(db/relate-nodes conn :LINKSTO node %)))))
-
-
-
-; Attributes to parse:
-; og:url - Base url
-; og:type - article type. Will be something like video.tv_show, we should probably capitalize it.  (split "video.tv_show" #"\.")
-; og:title - Article title
-;
-; Root article URL: http://tvtropes.org/pmwiki/pmwiki.php/
-; The identifier would be path-of minus /pmwiki/pmwiki.php/+      (pmap #(db/relate-nodes conn :LINKSTO node %)))))


Filter out images

Filter out images

--- src/wordly/word_count.clj
+++ src/wordly/word_count.clj
@@ -27,6 +27,7 @@
                 java.net.URL.
                 enlive/html-resource
                 (enlive/select [:body])
+                (enlive/transform [:img] nil)
                 (enlive/transform [:script] nil)
                 (enlive/transform [:style] nil)
                 texts


Update subs.cljs

Update subs.cljs

Minor change to match v0.8.0 in comment

--- examples/todomvc/src/todomvc/subs.cljs
+++ examples/todomvc/src/todomvc/subs.cljs
@@ -112,7 +112,7 @@
 ;; Is this a good idea?
 ;; If it is a good idea, is this good syntax?
 ;; Because it is so common to nominate 1 or more input signals,
-;; register-pure-sub provides some macro sugar so you can nominate a very minimal
+;; reg-sub provides some macro sugar so you can nominate a very minimal
 ;; vector of input signals. The 1st function is not needed.
 ;; Here is the example above rewritten using the sugar.
 #_(reg-sub


Made markdown-clj properly handle labels in section links.

--- lambda-blog/src/lambda_blog/parsers/md.clj
+++ lambda-blog/src/lambda_blog/parsers/md.clj
@@ -34,6 +34,7 @@
           [text state]
           (re-seq subs-regex text)))

+;; NOTE Extends default heading transformer with clickable section headers.
 (defn- heading-transformer [text {:keys [code codeblock heading-anchors heading-links] :as state}]
   (cond (or code codeblock)
         [text state]
@@ -41,8 +42,8 @@
         (heading-level text)
         (let [h (heading-level text)
               t (heading-text text)
-              l (sanitize t)]
-          ;; NOTE Clickable section headers.
+              ;; NOTE Not to expand potential formatting in the label.
+              [l s] (freeze-string (sanitize t) state)]
           [(str "<h" h ">"
                 (if heading-anchors
                   (str ""
@@ -51,7 +52,7 @@
                          t))
                   t)
                 "</h" h ">")
-           (assoc state :heading true)])
+           (assoc s :heading true)])

         :else
         [text state]))


add post-contains-tag? test

add post-contains-tag? test

--- test/misaki/test/core.clj
+++ test/misaki/test/core.clj
@@ -23,6 +23,15 @@
       "/2000-01/foo.html"  (:url data)
       (date-time 2000 1 1) (:date data)
       "
baz
" (force (:lazy-content data)))))
+
+(deftest* post-contains-tag?-test
+  (let [file (io/file (str *post-dir* "2011.01.01-foo.html.clj"))
+        data (get-post-data file)]
+    (are [x y] (= x y)
+      false (post-contains-tag? data "tag1")
+      true  (post-contains-tag? data "tag2")
+      true  (post-contains-tag? data "tag3")
+      false (post-contains-tag? data nil))))

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


finished the filter test

finished the filter test

--- test/sledge/core_test.clj
+++ test/sledge/core_test.clj
@@ -18,10 +18,16 @@
                  }
                 "http://localhost:53281")

+(defn results []
+  (tx/elements "div.results div.track"))
+
+(defn filters []
+  (tx/elements "span.filter"))
+
 (deftest the-tests
   (testing  "Server responds"
     (search-tracks "queen")
-    (let [els (tx/elements "div.results div.track")
+    (let [els (results)
           choose-rows (map #(nth els %) [2 4 6 11])]
       (dorun (map click-track-button choose-rows)))

@@ -45,7 +51,7 @@
   (search-tracks text)
   (tx/wait-until #(> (count (results)) 1))
   (tx/wait-until (fn []
-                   (some? #(matches (content %) (str "_content: " text))
+                   (some? #(= (tx/text %) (str "_content: " text))
                           (filters)))))

 (defn find-track-by-artist [artist]
@@ -58,14 +64,16 @@
   (testing  "search for text"
     (search-tracks "queen")
     (let [row (find-track-by-artist "Queen")]
-      (tx/click (tx/find-element-under row {:class :artist}))
-      ;; assert all tracks have matching artist
-      (tx/click (tx/find-element-under row {:class :album}))
-      ;; assert all tracks have matching album
-      ;; - verify three tags rendered
-      ;; - click on a tag
-      ;; - verify it has been removed
-
+      (tx/click (tx/find-element-under row {:class "artist"}))
+      (is (every? #{"Queen"}
+                  (map tx/text (rest (tx/elements "div.results.tracks span.artist")))))
+      (let [album (tx/find-element-under row {:class "album"})]
+        (tx/click album)
+        (is (every? (partial = (tx/text album))
+                    (map tx/text (rest (tx/elements "div.results.tracks span.album"))))))
+      (tx/wait-until #(= (count (filters)) 3))
+      (tx/click (first (filters)))
+      (tx/wait-until #(= (count (filters)) 2))
       )))

 (comment


Update to ClojureScript 0.0-2760

Update to ClojureScript 0.0-2760

--- Clojure/project.clj
+++ Clojure/project.clj
@@ -4,7 +4,7 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/clojurescript "0.0-2665"]]
+                 [org.clojure/clojurescript "0.0-2760"]]
   :source-paths ["src"]
   :compiler {
      :output-to "hello_world.js"


Confirm SSEs are UTF-8.

Confirm SSEs are UTF-8.

--- web/test/immutant/web/sse_test.clj
+++ web/test/immutant/web/sse_test.clj
@@ -14,7 +14,7 @@

 (ns immutant.web.sse-test
   (:require [clojure.test :refer :all]
-            [testing.web :refer (event-source handle-events)]
+            [testing.web :refer (event-source handle-events get-response)]
             [immutant.web.sse :refer :all]
             [immutant.web :refer (run stop)]
             [clojure.string :refer (split-lines)]))
@@ -61,3 +61,14 @@
     (is (= ["5" "4" "3" "2" "1"] (take 5 @result)))
     (is (= #{:done "bye!"} (set (drop 5 @result))))
     (stop server)))
+
+(deftest sse-encoding-should-be-utf8
+  (let [app (fn [req]
+              (as-channel req
+                :on-open (fn [ch] (send! ch "foo" {:close? true}))))
+        server (run app)
+        body-stream (:raw-body (get-response "http://localhost:8080"))]
+    (is body-stream)
+    (is (= "data:foo\n\n"
+          (String. (.toByteArray body-stream) "UTF-8")))
+    (stop server)))


add-backend test helper

add-backend test helper

--- test/merlion/core_test.clj
+++ test/merlion/core_test.clj
@@ -77,15 +77,18 @@
     (.setSoTimeout s 1000)
     (slurp (io/reader (.getInputStream s)))))

+(defn add-backend [name port]
+  (etcdctl (str "service/" domain-name "/" name "/listen-address")
+           (str "localhost:" port))
+  (etcdctl (str "service/" domain-name "/" name "/last-seen-at")
+           (.toString (java.time.Instant/now))))
+

 (deftest download
   (testing "small file transfer"
     (let [be-process (socat "test/fixtures/excerpt.txt")]
       (with-running-server [prefix port]
-        (etcdctl (str "service/" domain-name "/aaa/listen-address")
-                 (str "localhost:" (:port be-process)))
-        (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
-                 (.toString (java.time.Instant/now)))
+        (add-backend "aaa" (:port be-process))
         (Thread/sleep 500)
         (is (= (slurp "test/fixtures/excerpt.txt")
                (tcp-slurp port)))))))
@@ -95,10 +98,7 @@
   (testing "slow file transfer"
     (let [be-process (slow-socat "test/fixtures/excerpt.txt" 100)]
       (with-running-server [prefix port]
-        (etcdctl (str "service/" domain-name "/aaa/listen-address")
-                 (str "localhost:" (:port be-process)))
-        (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
-                 (.toString (java.time.Instant/now)))
+        (add-backend "aaa" (:port be-process))
         (Thread/sleep 500)
         (is (= (slurp "test/fixtures/excerpt.txt")
                (tcp-slurp port)))
@@ -110,10 +110,7 @@
     (let [be-process (slow-socat "test/fixtures/excerpt.txt" 100)]
       (let [fut
             (with-running-server [prefix port]
-              (etcdctl (str "service/" domain-name "/aaa/listen-address")
-                       (str "localhost:" (:port be-process)))
-              (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
-                       (.toString (java.time.Instant/now)))
+              (add-backend "aaa" (:port be-process))
               (Thread/sleep 500)
               (let [f (future (tcp-slurp port))]
                 (Thread/sleep 4000)
@@ -126,10 +123,7 @@
   (testing "deleting the backend does not interrupt transfer"
     (let [be-process (slow-socat "test/fixtures/excerpt.txt" 100)]
       (with-running-server [prefix port]
-        (etcdctl (str "service/" domain-name "/aaa/listen-address")
-                 (str "localhost:" (:port be-process)))
-        (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
-                 (.toString (java.time.Instant/now)))
+        (add-backend "aaa" (:port be-process))
         (Thread/sleep 500)
         (let [f (future (tcp-slurp port))]
           (Thread/sleep 4000)
@@ -150,10 +144,7 @@
   (testing "deleting a backend makes it stop responding"
     (let [be-process (socat "test/fixtures/excerpt.txt")]
       (with-running-server [prefix port]
-        (etcdctl (str "service/" domain-name "/aaa/listen-address")
-                 (str "localhost:" (:port be-process)))
-        (etcdctl (str "service/" domain-name "/aaa/last-seen-at")
-                 (.toString (java.time.Instant/now)))
+        (add-backend "aaa" (:port be-process))
         (Thread/sleep 500)
         (etcd-rm (str "service/" domain-name "/aaa"))
         (Thread/sleep 500)


Refactor field element getters

Refactor field element getters

--- spec/cljs/iframe_app/core_test.cljs
+++ spec/cljs/iframe_app/core_test.cljs
@@ -14,30 +14,31 @@
             [iframe-app.condition-selector :refer [fields-without-field]]
             [iframe-app.core :refer [main app]]))

-
-
 (enable-console-print!)
+(set! (.-warn js/console) (fn [t] nil))
+(def p println)

 (defonce app-state (atom {:conditions #{}}))
-
-(set! (.-warn js/console) (fn [t] nil))

 ; TODO: use test.check to generate behaviour
 ; TODO: make finders that wait til they find what they're looking for (like Capybara)

-(def p println)
+
+(defn get-field-by [field-type by field]
+  (sel1 (str "a." field-type "[data-" by "='" ((keyword by) field) "']")))
+
+
+(def get-master-field-element
+  (partial get-field-by "master-field" "id"))
+
+(def get-field-value-element
+  (partial get-field-by "field-value" "value"))
+
+(def get-slave-field-element
+  (partial get-field-by "slave-field" "id"))

-
-(defn get-master-field-element [field]
-  (sel1 (str "a.master-field[data-id='" (:id field) "']")))
-
-(defn get-field-value-element [field-value]
-  (sel1 (str "a.field-value[data-value='" (:value field-value) "']")))
-
-(defn get-slave-field-element [field]
-  (sel1 (str "a.slave-field[data-id='" (:id field) "']")))

 (defn element-click-fn [element-getter]
   (fn [arg]
@@ -84,16 +85,6 @@
                       :value        value})
                    behaviours)))

-
-(defn dummy-behaviour [ticket-fields]
-  (let [master-field (rand-nth ticket-fields)
-        field-value (rand-nth (:possible-values master-field))
-        slave-field (rand-nth (fields-without-field ticket-fields
-                                                    master-field))]
-    [[:select-master-field master-field],
-     [:select-field-value field-value],
-     [:select-slave-field slave-field]]))
-
 (defn setup-app [ticket-fields]
   (.appendChild (.-body js/document)
                 (let [element (.createElement js/document "div")
@@ -105,9 +96,18 @@
             :shared {:pick-channel  (chan)
                      :ticket-fields ticket-fields}}))

+(defn dummy-behaviour [ticket-fields]
+  (let [master-field (rand-nth ticket-fields)
+        field-value (rand-nth (:possible-values master-field))
+        slave-field (rand-nth (fields-without-field ticket-fields
+                                                    master-field))]
+    [[:select-master-field master-field],
+     [:select-field-value field-value],
+     [:select-slave-field slave-field]]))
+
+
 (deftest ^:async declarative
-  ; TODO: replace these dummy fields with generators
-  (let [ticket-fields (first (gen/sample ticket-fields-gen))
+  (let [ticket-fields (first (gen/sample ticket-fields-gen 1))
         behaviour (dummy-behaviour ticket-fields)
         states (get-states-for-behaviors behaviour)
         behaviours-with-state-afterwards (map vector behaviour (rest states))]


fix missing header bug

fix missing header bug

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_config_importer.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_config_importer.cljs
@@ -36,6 +36,7 @@
                    (swap! state assoc :importing? true)
                    (endpoints/call-ajax-orch
                      {:endpoint (endpoints/copy-method-config-to-workspace workspace-id)
+                      :headers {"Content-Type" "application/json"}
                       :payload {"configurationNamespace" selected-conf-namespace
                                 "configurationName" selected-conf-name
                                 "configurationSnapshotId" (str selected-conf-snapshot-id)


Refactor in support of IMMUTANT-488

Refactor in support of IMMUTANT-488

--- web/src/immutant/web/undertow.clj
+++ web/src/immutant/web/undertow.clj
@@ -17,18 +17,33 @@
   (:require [immutant.internal.util :refer [kwargs-or-map->map]])
   (:import [io.undertow Undertow]))

-(defn builder
-  "Create an Undertow$Builder instance, from which an Undertow server
-  can be built"
-  [{:keys [host port io-threads worker-threads buffer-size buffers-per-region direct-buffers?]
-    :or {host "localhost" port 8080}}]
-  (cond-> (Undertow/builder)
-    true                         (.addHttpListener port host)
-    io-threads                   (.setIoThreads io-threads)
-    worker-threads               (.setWorkerThreads worker-threads)
-    buffer-size                  (.setBufferSize buffer-size)
-    buffers-per-region           (.setBuffersPerRegion buffers-per-region)
-    (not (nil? direct-buffers?)) (.setDirectBuffers direct-buffers?)))
+(defn tune
+  "Return the passed tuning options with an Undertow$Builder instance
+  set accordingly, mapped to :configuration in the return value"
+  [{:keys [configuration io-threads worker-threads buffer-size buffers-per-region direct-buffers?]
+    :as options}]
+  (let [builder (or configuration (Undertow/builder))]
+    (assoc options
+      :configuration
+      (cond-> builder
+        io-threads                   (.setIoThreads io-threads)
+        worker-threads               (.setWorkerThreads worker-threads)
+        buffer-size                  (.setBufferSize buffer-size)
+        buffers-per-region           (.setBuffersPerRegion buffers-per-region)
+        (not (nil? direct-buffers?)) (.setDirectBuffers direct-buffers?)))))
+
+(defn listen
+  "Return the passed listener-related options with an Undertow$Builder
+  instance set accordingly, mapped to :configuration in the return
+  value. At a minimum, :host and :port are required."
+  [{:keys [configuration host port ssl-context key-managers trust-managers]
+    :as options}]
+  (let [builder (or configuration (Undertow/builder))]
+    (cond
+      ssl-context  (.addHttpsListener builder port host ssl-context)
+      key-managers (.addHttpsListener builder port host key-managers trust-managers)
+      port         (.addHttpListener  builder port host))
+    (assoc options :configuration builder)))

 (defn options
   "Takes a map of {{immutant.web/run}} options that includes a subset
@@ -37,5 +52,7 @@
   [& opts]
   (let [options (kwargs-or-map->map opts)]
     (-> options
-      (assoc :configuration (builder options))
-      (dissoc :io-threads :worker-threads :buffer-size :buffers-per-region :direct-buffers?))))
+      tune
+      listen
+      (dissoc :io-threads :worker-threads :buffer-size :buffers-per-region :direct-buffers?
+        :ssl-context :key-managers :trust-managers))))


More news text

More news text

--- demo/reagentdemo/news/news060.cljs
+++ demo/reagentdemo/news/news060.cljs
@@ -21,12 +21,13 @@
   (:people @app-state))

 (defn person-keys []
-  (let [m @(r/track people)]
-    (keys m)))
+  (-> @(r/track people)
+      keys
+      sort))

 (defn person [id]
-  (let [m @(r/track people)]
-    (get m id)))
+  (-> @(r/track people)
+      (get id)))

 (defn name-comp [id]
   (let [p @(r/track person id)]
@@ -53,8 +54,8 @@
        [:h2 "Use any function as a reactive value"]

        [:p [:code "reagent.core/track"] " takes a function, and
-       optional arguments for that function, and returns an
-       ”atom-like” value that can be derefed, and gives whatever is
+       optional arguments for that function, and gives a
+       derefable (i.e ”atom-like”) value, containing whatever is
        returned by that function. If the tracked function depends on a
        Reagent atom, the function is called again whenever that atom
        changes – just like a Reagent component function. If the value
@@ -64,7 +65,7 @@

        [:p "In other words, " [:code "@(r/track foo x)"] " gives the
        same result as " [:code "(foo x)"] " – but in the first case,
-       foo is only called again when the atoms it depends on
+       foo is only called again when the atom(s) it depends on
        changes."]

        [:p "Here's an example: "]
@@ -78,9 +79,29 @@
                                         :name-list])}]

        [:p "Here, the " [:code "name-list"] " component will only be
-       re-rendered if the keys to the " [:code ":people"] " map
+       re-rendered if the keys of the " [:code ":people"] " map
        changes. Every " [:code "name-comp"] " only renders again when
        needed, etc."]
+
+       [:p "Use of " [:code "track"] " can improve performance in
+       three ways:" ]
+
+       [:ul
+        [:li "It can be used as a cache for an expensive function,
+        that is automatically updated if that function depends on Reagent
+        atoms (or other tracks, cursors, etc)."]
+
+        [:li "It can also be used to limit the number of times a
+        component is re-rendered. The user of " [:code "track"] " is
+        only updated when the function’s result changes. In other
+        words, you can use track as a kind of generalized, read-only
+        cursor."]
+
+        [:li "Every use of " [:code "track"] " with the same arguments
+        will only result in one execution of the function. E.g the two
+        uses of " [:code "@(r/track people)"] " in the example above
+        will only result in one call to the " [:code "people"] "
+        function (both initially, and when the state atom changes)."]]

        ])]])


GAWB-1206: remove rename process since it's part of update now

--- src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
+++ src/cljs/main/broadfcui/page/workspace/method_configs/method_config_editor.cljs
@@ -59,18 +59,8 @@
                   (if-not success?
                     (do (comps/push-error (str "Exception:\n" (.-statusText xhr)))
                         (swap! state dissoc :blocker))
-                    (if (= name (config "name"))
-                      (swap! state assoc :loaded-config (get-parsed-response false) :blocker nil)
-                      (endpoints/call-ajax-orch ;; TODO - make unified call in orchestration
-                        {:endpoint (endpoints/rename-workspace-method-config workspace-id config)
-                         :payload (select-keys new-conf ["name" "namespace" "workspaceName"])
-                         :headers utils/content-type=json
-                         :on-done (fn [{:keys [success? xhr]}]
-                                    (swap! state dissoc :blocker)
-                                    (if success?
-                                      ((:on-rename props) name)
-                                      (comps/push-error
-                                       (str "Exception:\n" (.-statusText xhr)))))}))))})))
+                    (do ((:on-rename props) name)
+                        (comps/push-error (str "Exception:\n" (.-statusText xhr))))))})))

 (react/defc MethodDetailsViewer
   {:get-fields


CMR-6161 trying to reset fixtures

CMR-6161 trying to reset fixtures

--- system-int-test/test/cmr/system_int_test/search/autocomplete_collection_facet_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/autocomplete_collection_facet_search_test.clj
@@ -23,6 +23,7 @@
     (esd/delete conn "1_autocomplete" "suggestion" (:_id baz))
     (index/wait-until-indexed)))

+(use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"}))
 (use-fixtures :each autocomplete-fixture)

 (deftest autocomplete-suggest-test


Refactor quest event handlers

Refactor quest event handlers

--- src/braid/quests/client/events.cljs
+++ src/braid/quests/client/events.cljs
@@ -1,7 +1,7 @@
 (ns braid.quests.client.events
   (:require
     [cljs-uuid-utils.core :as uuid]
-    [re-frame.core :refer [reg-event-db reg-event-fx]]
+    [re-frame.core :refer [reg-event-fx]]
     [braid.quests.client.helpers :as helpers]
     [braid.quests.client.list :refer [quests-by-id]]))

@@ -13,59 +13,58 @@

 (reg-event-fx
   :quests/activate-next-quest
-  (fn [{state :db :as cofx} _]
-    (if-let [quest (helpers/get-next-quest state)]
-      (let [quest-record (make-quest-record {:quest-id (quest :quest/id)})
-            state (helpers/store-quest-record state quest-record)]
-        {:db state
+  (fn [{db :db} _]
+    (if-let [quest (helpers/get-next-quest db)]
+      (let [quest-record (make-quest-record {:quest-id (quest :quest/id)})]
+        {:db (helpers/store-quest-record db quest-record)
          :websocket-send (list [:braid.server.quests/upsert-quest-record quest-record])})
       {})))

 (reg-event-fx
   :quests/skip-quest
-  (fn [state [_ quest-record-id]]
-    (let [state (helpers/skip-quest state quest-record-id)]
+  (fn [db [_ quest-record-id]]
+    (let [db (helpers/skip-quest db quest-record-id)]
       {:websocket-send
        (list [:braid.server.quests/upsert-quest-record
-              (helpers/get-quest-record state quest-record-id)])
+              (helpers/get-quest-record db quest-record-id)])
        :dispatch [:quests/activate-next-quest]})))

 (reg-event-fx
   :quests/complete-quest
-  (fn [{state :db :as cofx} [_ quest-record-id]]
-    (let [state (helpers/complete-quest state quest-record-id)]
+  (fn [{db :db} [_ quest-record-id]]
+    (let [db (helpers/complete-quest db quest-record-id)]
       {:websocket-send
        (list [:braid.server.quests/upsert-quest-record
-              (helpers/get-quest-record state quest-record-id)])
+              (helpers/get-quest-record db quest-record-id)])
        :dispatch [:quests/activate-next-quest]})))

 (reg-event-fx
   :quests/increment-quest
-  (fn [{state :db :as cofx} [_ quest-record-id]]
-    (let [state (helpers/increment-quest state quest-record-id)]
-      {:db state
+  (fn [{db :db} [_ quest-record-id]]
+    (let [db (helpers/increment-quest db quest-record-id)]
+      {:db db
        :websocket-send (list [:braid.server.quests/upsert-quest-record
-                              (helpers/get-quest-record state quest-record-id)])})))
+                              (helpers/get-quest-record db quest-record-id)])})))

-(reg-event-db
+(reg-event-fx
   :quests/upsert-quest-record
-  (fn [state [_ quest-record]]
-    (helpers/store-quest-record state quest-record)))
+  (fn [{db :db} [_ quest-record]]
+    {:db (helpers/store-quest-record db quest-record)}))

-(defn maybe-increment-quest-record [state quest-record event args]
+(defn maybe-increment-quest-record [db quest-record event args]
   (let [quest (quests-by-id (quest-record :quest-record/quest-id))
-        inc-progress? ((quest :quest/listener) state [event args])
+        inc-progress? ((quest :quest/listener) db [event args])
         local-only? (:local-only? args)]
     (when (and inc-progress? (not local-only?))
       [:quests/increment-quest (quest-record :quest-record/id)])))

 (reg-event-fx
   :quests/update-handler
-  (fn [{state :db :as cofx} [_ [event args]]]
+  (fn [{db :db} [_ [event args]]]
     {:dispatch-n
      (into ()
            (comp (map
                    (fn [quest-record]
-                     (maybe-increment-quest-record state quest-record event args)))
+                     (maybe-increment-quest-record db quest-record event args)))
                  (remove nil?))
-           (helpers/get-active-quest-records state))}))
+           (helpers/get-active-quest-records db))}))


Explicitly specify jruby version. rvm wanted to auto-upgrade us

--- src/circle/backend/nodes/circle.clj
+++ src/circle/backend/nodes/circle.clj
@@ -70,8 +70,8 @@
                              (rvm/rvm)
                              (circle-pallet/user-code
                               (source "~/.bashrc") ;; make sure RVM is loaded
-                              (rvm install jruby)
-                              (rvm use jruby)
+                              (rvm install jruby-1.6.5)
+                              (rvm use jruby-1.6.5)
                               (rvm gemset create circle)
                               (rvm gemset use circle)
                               (gem install bundler)


Move $ga-script-tag above usage

Move $ga-script-tag above usage

--- src/clj/clojuredocs/site/common.clj
+++ src/clj/clojuredocs/site/common.clj
@@ -8,6 +8,16 @@
 (def gh-auth-url (gh/auth-redirect-url
                    (merge config/gh-creds
                           {:redirect-uri (config/url "/gh-callback")})))
+
+(defn $ga-script-tag [ga-tracking-id]
+  (when ga-tracking-id
+    [:script "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+  })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+
+  ga('create', '" ga-tracking-id "', 'auto');
+  ga('send', 'pageview');"]))

 (defn $user-area [user]
   [:li.user-area
@@ -195,13 +205,3 @@
        [:h1 "404"]
        [:a.four-oh-four {:href "http://emareaf.deviantart.com/art/Rich-Hickey-321501046"}
         [:img.four-oh-four {:src "http://fc04.deviantart.net/fs70/f/2012/229/a/6/rich_hickey_by_emareaf-d5bevsm.png"}]]]]}))
-
-(defn $ga-script-tag [ga-tracking-id]
-  (when ga-tracking-id
-    [:script "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
-  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
-  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
-  })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
-
-  ga('create', '" ga-tracking-id "', 'auto');
-  ga('send', 'pageview');"]))


'All' set filter + set sorted by release date

--- src/cljs/netrunner/cardbrowser.cljs
+++ src/cljs/netrunner/cardbrowser.cljs
@@ -37,7 +37,7 @@
   (reify
     om/IInitState
     (init-state [this]
-      {:set-filter "Core Set"
+      {:set-filter ""
        :filter-ch (chan)})

     om/IWillMount
@@ -51,7 +51,9 @@
       (sab/html
        [:div.cardbrowser
         [:div.blue-shade.panel.set-list {}
-         (for [set (:sets cursor)]
+         [:div {:class (if (= (:set-filter state) "") "active" "")
+                :on-click #(om/set-state! owner :set-filter "")} "All"]
+         (for [set (sort-by :available (:sets cursor))]
            (om/build set-view
                      {:set set :set-filter (:set-filter state)}
                      {:init-state {:ch (:filter-ch state)}}))]


Implemented alliances in deckbuilder

Implemented alliances in deckbuilder

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -31,6 +31,9 @@
   (let [napdmwl '("Cerberus \"Lady\" H1" "Clone Chip" "Desperado" "Parasite" "Prepaid VoicePAD" "Yog.0"
                    "Architect" "AstroScript Pilot Program" "Eli 1.0" "NAPD Contract" "SanSan City Grid")]
     (some #(= (:title card) %) napdmwl)))
+
+(defn card-count [cards]
+  (reduce #(+ %1 (:qty %2)) 0 cards))

 (defn noinfcost? [identity card]
   (or (= (:faction card) (:faction identity))
@@ -152,6 +155,7 @@
   [deck]
   (let [identity (:identity deck)
         cards (:cards deck)
+        ;; sums up influence of a cardlist by faction to a map
         infhelper (fn [currmap line]
                     (let [card (:card line)]
                       (if (= (:faction card) (:faction identity))
@@ -159,14 +163,60 @@
                         (update-in currmap [(keyword (faction-label card))]
                                    (fnil (fn [curinf] (+ curinf (* (:qty line) (:factioncost card))))
                                          0)))))
-        infmap (reduce infhelper {} cards)]
-    (if (= (:title identity) "The Professor: Keeper of Knowledge")
-      (let [progs (filter #(= "Program" (:type (:card %))) cards)
-            ;importedprogs (filter #((complement noinfcost?) identity (:card %)) progs)
-            singledprogs (reduce #(conj %1 (assoc-in %2 [:qty] 1)) '() progs)
-            singledinfmap (reduce infhelper {} singledprogs)]
-      (merge-with - infmap singledinfmap))
-      infmap)))
+        infmap (reduce infhelper {} cards)
+        ;; sums up influence of one of each imported programs, to resolve Professor's ability
+        profhelper (fn [arg-infmap]
+                     (let [progs (filter #(= "Program" (:type (:card %))) cards)
+                           ;; list with single programs
+                           singled-progs (reduce #(conj %1 (assoc-in %2 [:qty] 1)) '() progs)
+                           singled-infmap (reduce infhelper {} singled-progs)]
+                       (merge-with - arg-infmap singled-infmap)))
+        infmap (if (= (:code identity) "03029") ; The Professor: Keeper of Knowledge
+                 (profhelper infmap)
+                 infmap)
+        ;; dirty hack in place until the :subtype is figured out below
+        has-alliance-subtype? (fn [card]
+                                (case (:code (:card card))
+                                  (list "10013" "10018" "10019" "10067" "10068" "10071" "10072" "10076" "10109")
+                                  true
+                                  false))
+        ; line below doesn't work, probably because cards don't have :subtype here, figure out why TODO
+        ; has-alliance-subtype? (fn [card] (not= -1 (.indexOf (:subtype (:card card)) "Alliance")))
+        ;; alliance helper, subtracts influence of free ally cards from given influence map
+        allyhelper (fn [arg-infmap]
+                     (let [ally-cards (filter has-alliance-subtype? cards)
+                           ;; Implements the standard alliance check, 6 or more non-alliance faction cards
+                           default-alliance-free? (fn [card]
+                                                    (<= 6 (card-count (filter #(and (= (:faction (:card card))
+                                                                                (:faction (:card %)))
+                                                                                (not (has-alliance-subtype? %)))
+                                                                              cards))))
+                           ;; checks card for alliance conditions and returns true if they are met
+                           is-ally-free? (fn [card]
+                                           (case (:code (:card card))
+                                             (list
+                                               "10013" ; Heritage Committee
+                                               "10067" ; Jeeves Model Bioroids
+                                               "10068" ; Raman Rai
+                                               "10071" ; Salem's Hospitality
+                                               "10072" ; Executive Search Firm
+                                               "10109") ; Ibrahim Salem
+                                             (default-alliance-free? card)
+                                             "10018" ; Mumba Temple
+                                             (>= 15 (card-count (filter #(= "ICE" (:type (:card %))) cards)))
+                                             "10019" ; Museum of History
+                                             (<= 50 (card-count cards))
+                                             "10076" ; Mumbad Virtual Tour
+                                             (<= 7 (card-count (filter #(= "Asset" (:type (:card %))) cards)))
+                                             false))
+                           free-ally-cards (filter is-ally-free? ally-cards)
+                           free-ally-infmap (reduce infhelper {} free-ally-cards)]
+                       (merge-with - arg-infmap free-ally-infmap)))
+        infmap (if (some has-alliance-subtype? cards)
+                 (allyhelper infmap)
+                 infmap)]
+    infmap
+    ))

 (defn mostwanted-count
   "Returns total number of MWL restricted cards in a deck."
@@ -183,9 +233,6 @@
         postmwlinf (- originf (mostwanted-count deck))]
     (if (= originf INFINITY) ; FIXME this ugly 'if' could get cut when we get a proper nonreducible infinity in CLJS
       INFINITY (if (> 1 postmwlinf) 1 postmwlinf))))
-
-(defn card-count [cards]
-  (reduce #(+ %1 (:qty %2)) 0 cards))

 (defn min-agenda-points [deck]
   (let [size (max (card-count (:cards deck)) (get-in deck [:identity :minimumdecksize]))]


fix alternate arts logic

fix alternate arts logic

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -24,7 +24,10 @@

 (defn lookup [side query]
   (let [q (.toLowerCase query)
-        cards (filter #(= (:side %) side) (:cards @app-state))]
+        cards (filter #(and (= (:side %) side)
+                            (or (get-in @app-state [:user :special])
+                                (not= "Alternates" (:setname %))))
+                      (:cards @app-state))]
     (if-let [card (some #(when (= (-> % :title .toLowerCase) q) %) cards)]
       card
       (loop [i 2 matches cards]


allow paragraphs in topic content

allow paragraphs in topic content

--- src/clojurelive_web/view/common.clj
+++ src/clojurelive_web/view/common.clj
@@ -1,5 +1,6 @@
 (ns clojurelive-web.view.common
-  (:require [hiccup.page :as h]
+  (:require [clojure.string :as string]
+            [hiccup.page :as h]
             [hiccup.util :as hiccup-util]))

 (def head
@@ -66,6 +67,9 @@
 ga('create', 'UA-62980400-1', 'auto');
 ga('send', 'pageview');"])

+(defn prettify [content]
+  (string/replace content #"(\r\n)+" "</p><p>"))
+
 (defmulti render-title :type)
 (defmethod render-title :default [_] nil)
 (defmethod render-title "link" [this]
@@ -78,5 +82,5 @@
   [:hr])
 (defmethod render-body "text" [this]
   (list
-   [:p (hiccup-util/escape-html (:content this))]
+   [:p (prettify (hiccup-util/escape-html (:content this)))]
    [:hr]))


refactored change-object-name, change-attribute-name, change-incidence-cross

--- src/conexp/gui/editors/contexts.clj
+++ src/conexp/gui/editors/contexts.clj
@@ -111,7 +111,7 @@
 (deftype context-editor-widget [widget table toolbar e-ctx])
 (derive ::context-editor-widget :conexp.gui.editors.util/widget)

-(declare make-editable-context editable-context?)
+(declare make-editable-context editable-context? add-widget get-context)

 (defn-swing make-context-editor-widget
   "Creates a control for editing contexts.
@@ -244,6 +244,7 @@
       (doseq [x setup] (unroll-parameters-fn-map widget x))
       widget )))

+(declare change-attribute-name change-object-name change-incidence-cross)

 (defn- ectx-cell-value-hook ;;TODO!!! ...
   [ectx editor row column contents]
@@ -253,16 +254,12 @@
            (let [attrib-cols @(:attr-cols ectx)
                   current-name (attrib-cols column)]
              (if (= contents current-name) current-name
-               current-name
-                                        ;(change-attribute-name column contents)
-               ))
+               (change-attribute-name ectx column contents)))
            (= column 0)
            (let [object-rows @(:obj-rows ectx)
                   current-name (object-rows row)]
              (if (= contents current-name) current-name
-                                        ;(change-object-name row contents)
-               current-name
-               ))
+               (change-object-name ectx row contents)))
            true ;else
            (let [ cross (string-to-cross contents)
                   obj-name (@(:obj-rows ectx) row)
@@ -270,17 +267,14 @@
                   fca-ctx (get-context ectx)
                   inc (incidence fca-ctx)
                   current-state (contains? inc [obj-name attr-name])]
-
              (if (not= current-state cross)
-                               ;(update-incidence obj-name attr-name cross)
-               nil
-               )
+               (change-incidence-cross ectx obj-name attr-name cross))
              (if cross "X" " "))
            )
          other-widgets (del @(:widgets ectx) editor)]

-    (call-many other-widgets (fn [x] (update-value-at-index (get-table x)
-                                       row column good-value)))
+;    (call-many other-widgets (fn [x] (update-value-at-index (get-table x)
+;                                       row column good-value)))
     good-value))

@@ -393,6 +387,113 @@
       (fn [r c s] (ectx-cell-value-hook e-ctx editor r c s)))))

+(declare change-attribute-name change-object-name change-incidence-cross)
+
+(inherit-multimethod change-incidence-cross ::editable-context
+ "Sets or unsets the cross in the incidence relation of the editable-context.
+
+  Parameters:
+     ectx       _editable-context
+     obj        _object
+     att        _attribute
+     cross      _true or false")
+
+(defmethod change-incidence-cross ::editable-context
+  [ectx obj att cross]
+  (let [ ostr (if (= (type obj) String) obj
+                (@(:obj-rows ectx) obj))
+         astr (if (= (type att) String) att
+                (@(:attr-cols ectx) att)) ]
+    (dosync-wait
+      (commute (:context ectx)
+        (fn [x]
+          (let [ as (attributes x)
+                 os (objects x)
+                 ir (incidence x) ]
+            (if cross (make-context os as (conj ir [ostr astr]))
+              (make-context os as (disj ir [ostr astr])))))))
+    (let [ row (@(:obj-rows ectx) ostr)
+           col (@(:attr-cols ectx) astr) ]
+      (call-many @(:widgets ectx)
+        (fn [w] (update-value-at-index (get-table w)
+                  row col (if cross "X" " ")))))))
+
+
+(inherit-multimethod change-attribute-name ::editable-context
+ "Changes the attributes name of given to requested, if requested is
+  not taken by another attribute. In this case, -# with a unique # is
+  appended to the requested name. Returns the new attribute name
+
+  Parameters:
+     ectx       _editable-context
+     given      _current attribute name or column index
+     requested  _requested new attribute name")
+
+(defmethod change-attribute-name ::editable-context
+  [ectx given requested]
+  (let [ att-cols @(:attr-cols ectx) ]
+    (if (= (type given) String)
+      (change-attribute-name ectx (att-cols given) requested)
+      (dosync-wait
+        (let [ ctx  (get-context ectx)
+               current-name (att-cols given)
+               attribs (attributes ctx)
+               other-attribs (disj attribs current-name)
+               new-name (req-unique-string other-attribs requested) ]
+          (when-not (= current-name new-name)
+            (let [ amap (fn [x] (if (= x current-name) new-name x)) ]
+              (commute (:context ectx)
+                (fn [x] (let [ as (conj (disj (attributes x) current-name)
+                                    new-name)
+                               os (objects x)
+                               ir (map (fn [x] [(first x)(amap (second x))])
+                                    (incidence x))]
+                          (make-context os as ir))))
+              (commute (:attr-cols ectx) switch-bipartit-auto
+                given current-name given new-name)
+              (call-many @(:widgets ectx)
+                (fn [w] (update-value-at-index (get-table w)
+                          0 given new-name)))))
+          new-name)))))
+
+
+(inherit-multimethod change-object-name ::editable-context
+ "Changes the object's name of given to requested, if requested is
+  not taken by another object. In this case, -# with a unique # is
+  appended to the requested name. Returns the new attribute name
+
+  Parameters:
+     ectx       _editable-context
+     given      _current attribute name or column index
+     requested  _requested new attribute name")
+
+(defmethod change-object-name ::editable-context
+  [ectx given requested]
+  (let [ obj-cols @(:obj-rows ectx) ]
+    (if (= (type given) String)
+      (change-object-name ectx (obj-cols given) requested)
+      (dosync-wait
+        (let [ ctx  (get-context ectx)
+               current-name (obj-cols given)
+               objs (objects ctx)
+               other-objs (disj objs current-name)
+               new-name (req-unique-string other-objs requested) ]
+          (when-not (= current-name new-name)
+            (let [ omap (fn [x] (if (= x current-name) new-name x)) ]
+              (commute (:context ectx)
+                (fn [x] (let [ os (conj (disj (objects x) current-name)
+                                    new-name)
+                               as (attributes x)
+                               ir (map (fn [x] [(omap (first x))(second x)])
+                                    (incidence x))]
+                          (make-context os as ir))))
+              (commute (:obj-rows ectx) switch-bipartit-auto
+                given current-name given new-name)
+              (call-many @(:widgets ectx)
+                (fn [w] (update-value-at-index (get-table w)
+                          given 0 new-name)))))
+          new-name)))))
+

 (defn make-editable-context2
@@ -481,40 +582,6 @@
                                 (make-context objs attrs
                                   (op inc [object attribute])))))))

-           change-attribute-name
-           (fn-doc "This function will change the name of the attribute in
-  the specified column to the new given name, if the new name does not conflict,
-  or otherwise to a conflict free new name; and returns the new name of the
-  attribute.
-
-  Parameters:
-    model-column   _column of the attribute in the model
-    req-name       _requested new attribute name"
-             [model-column req-name]
-             (dosync-wait
-               (let [ attribs (attributes (get-context @context))
-                      current-name (@attr-cols model-column)
-                      other-attribs (disj attribs current-name)
-                      new-name (req-unique-string other-attribs
-                                 req-name) ]
-                 (do
-                   (if (not= current-name new-name)
-                     (let [ amap (fn [x] (if (= x current-name) new-name x))]
-                       (dosync
-                         (commute context
-                           (fn [x] (let [as (conj (disj (attributes x)
-                                                    current-name)
-                                              new-name)
-                                         os (objects x)
-                                         inc (map
-                                               (fn [x] [ (first x)
-                                                         (amap (second x))])
-                                               (incidence x))]
-                                     (make-context os as inc))))
-                         (commute attr-cols switch-bipartit-auto
-                           model-column current-name
-                           model-column new-name))))
-                   new-name))))

            change-object-name
            (fn-doc "This function will change the name of the object in


move to lib templates

move to lib templates

--- server/src/gratefulplace/controllers/credential_recovery/forgot_username.clj
+++ server/src/gratefulplace/controllers/credential_recovery/forgot_username.clj
@@ -3,19 +3,15 @@
             [gratefulplace.db.validations :as validations]
             [gratefulplace.email.sending.senders :as email]
             [gratefulplace.controllers.shared :refer :all]
-            [liberator.core :refer [defresource]]
+            [com.flyingmachine.liberator-templates.sets.json-crud
+             :refer (defshow defcreate! defupdate!)]
             [flyingmachine.webutils.utils :refer :all]))

-(defresource create! [params]
-  :allowed-methods [:post]
-  :available-media-types ["application/json"]
-
-  :malformed? (validator params validations/forgot-username)
-  :handle-malformed errors-in-ctx
-
+(defcreate!
+  [params]
+  :invalid? (validator params validations/forgot-username)
   :exists? (fn [_] (exists? (seq (dj/all [:user/email (:email params)]))))
   :can-post-to-missing? false
   :handle-not-found (fn [_] {:errors {:email ["That email address doesn't exist"]}})
-
   :post! (fn [ctx] (future (email/send-forgot-username (:record ctx))))
-  :handle-created {})+  :return {})


CMR-3278: Minor refactoring.

CMR-3278: Minor refactoring.

--- access-control-app/src/cmr/access_control/services/permitted_concept_id_search.clj
+++ access-control-app/src/cmr/access_control/services/permitted_concept_id_search.clj
@@ -97,9 +97,9 @@
   "Constructs query condition for searching permitted_concept_ids by entry_titles"
   [parsed-metadata]
   (let [entry-title (:EntryTitle parsed-metadata)]
-    (gc/and-conds
-      [(common-qm/boolean-condition :collection-applicable true)
-       (common-qm/string-condition :entry-title entry-title true false)])))
+    (gc/and
+     (common-qm/boolean-condition :collection-applicable true)
+     (common-qm/string-condition :entry-title entry-title true false))))

 (defn get-permitted-concept-id-conditions
   "Returns query to search for ACLs that could permit given concept"