Different views for Event page for admin vs. attendee

Condition is just hard-coded in for now, until I figure out permissions.
Admins can upload images.

--- src/cljs/elevent_client/core.cljs
+++ src/cljs/elevent_client/core.cljs
@@ -95,6 +95,7 @@

 (def api-url "https://elevent.solutions:44300")
+(def api-url-http "http://elevent.solutions:8860")

 ;; REST
@@ -937,6 +938,81 @@
             "Charge different card"
             [:i.right.chevron.icon]]])))))

+(defn event-details-component [event]
+  [:div
+   [:div
+    [:b "Date: "]
+    (when (and (:StartDate event)
+               (:EndDate event))
+      (let [start (from-string (:StartDate event))
+            end   (from-string (:EndDate   event))]
+        (str (unparse datetime-formatter start)
+             (when (after? end start)
+               (str " to "
+                    (unparse datetime-formatter end))))))]
+   [:div
+    [:b "Venue: "] (:Venue event)]
+   [:p (:Description event)]])
+
+(defn activity-details-component [activity]
+  [:div
+   [:div.meta [:strong "Location: "] (:Location activity)]
+   [:div.meta [:strong "Time: "]
+    (str (when activity
+           (unparse datetime-formatter
+                    (from-string
+                      (:StartTime activity))))
+         " - "
+         (when activity
+           (unparse datetime-formatter
+                    (from-string
+                      (:EndTime activity)))))]
+   (when (> (:TicketPrice activity) 0)
+     [:div.meta
+      [:strong "Ticket Price: "]
+      (goog.string.format "$%.2f" (:TicketPrice activity))])
+   [:div.description
+    (:Description activity)]])
+
+(defn schedule-component [scheduled-activities & [button-text button-action footer-button]]
+  [:table.ui.table
+   [:thead
+    [:tr
+     [:th "Start"]
+     [:th "End"]
+     [:th "Activity"]
+     [:th "Location"]
+     [:th]]]
+   [:tbody
+    (for [[schedule-id activity-id] scheduled-activities]
+      ^{:key schedule-id}
+      (let [activity
+            (when activity-id
+              (d/entity @activities-db activity-id))]
+        [:tr
+         [:td {:noWrap true}
+          (when activity
+            (unparse datetime-formatter
+                     (from-string (:StartTime activity))))]
+         [:td {:noWrap true}
+          (when activity
+            (unparse datetime-formatter
+                     (from-string (:EndTime activity))))]
+         [:td (:Name activity)]
+         [:td (:Location activity)]
+         [:td.right.aligned {:noWrap true}
+          (when button-text
+            [:div.ui.small.button
+             {:on-click #(button-action schedule-id activity-id)}
+             button-text])]]))]
+   (when footer-button
+     [:tfoot
+      [:tr
+       [:th {:colSpan "6"}
+        footer-button
+        #_[:div.ui.small.labeled.icon.button
+         [:i.print.icon] "Print"]]]])])
+

 ;; Helpers
 ;; =============================================================================
@@ -958,7 +1034,12 @@
                                       :in $ ?event-id
                                       :where [?activity-id :EventId ?event-id]]
                                     @activities-db
-                                    event-id)))]
+                                    event-id)))
+        delete-activity! (fn [activity-id]
+                           (prn (d/entity @activities-db activity-id))
+                           (activities-endpoint :delete
+                                                (d/entity @activities-db activity-id)
+                                                nil))]
     [:table.ui.table
      [:thead
       [:tr
@@ -977,10 +1058,14 @@
                 (unparse datetime-formatter end))]
          [:td (:Name activity)]
          [:td (:Location activity)]
-         [:td [:a.ui.tiny.labeled.icon.button
-               {:href (event-activity-edit-route activity)}
-               [:i.edit.icon]
-               "Edit"]]])]]))
+         [:td
+          [:a
+           {:href (event-activity-edit-route activity)}
+           [:i.edit.icon]]
+          [:span
+           {:style {:cursor "pointer"}
+            :on-click #(delete-activity! (:ActivityId activity))}
+           [:i.red.remove.icon]]]])]]))

 ;; Pages
@@ -1098,75 +1183,55 @@
             "Sign up"]]]]))))

 (defn events-page []
-  (let [leave-event (fn [attendee-id]
-                      ; TODO: this doesn't delete schedules
-                      (attendees-endpoint :delete
-                                          (d/entity @attendees-db attendee-id)
-                                          nil))]
-    (fn []
-      (if (:token @session)
-        (let [attending-events
-              (doall (map (fn [[event-id attendee-id]]
-                            (assoc
-                              (into {} (d/entity @events-db event-id))
-                              :AttendeeId attendee-id))
-                          (d/q '[:find ?event-id ?attendee-id
-                                 :in $ ?user-id
-                                 :where
-                                 [?attendee-id :UserId  ?user-id]
-                                 [?attendee-id :EventId ?event-id]]
-                               @attendees-db
-                               (get-in @session [:user :UserId]))))]
-          [:div.sixteen.wide.column
-           [:div.ui.top.attached.tabular.menu
-            [:a.active.item {:href (events-route)}
-             "Events"]
-            [:a.item {:href (events-explore-route)}
-             "Explore"]
-            [:a.item {:href (events-owned-route)}
-             "Owned"]
-            [:a.item {:href (event-add-route)}
-             "Add"]]
-           [:div.ui.bottom.attached.segment
-            [:div
-             [:div.ui.vertical.segment
-              [:h1.ui.header "Events You're Attending"]]
-             [:div.ui.vertical.segment
-              (if (seq attending-events)
-                [:div.ui.divided.items
-                 (for [event attending-events]
-                   ^{:key (:EventId event)}
-                   [:div.item
-                    [:div.content
-                     [:a.header {:href (event-route event)}
-                      (:Name event)]
-                     [:div.meta
-                      [:strong "Date:"]
-                      (let [start (from-string (:StartDate event))
-                            end   (from-string (:EndDate   event))]
-                        (str (unparse datetime-formatter start)
-                             (when (after? end start)
-                               (str " to " (unparse datetime-formatter end)))))]
-                     [:div.meta
-                      [:strong "Venue:"]
-                      (:Venue event)]
-                     [:div.description
-                      (:Description event)]
-                     [:div.extra
-                      [:a.ui.right.floated.small.button
-                       {:href (event-schedule-route event)}
-                       "Your activities"
-                       [:i.right.chevron.icon]]
-                      [:a.ui.right.floated.small.button
-                       {:on-click #(leave-event (:AttendeeId event))}
-                       [:i.red.remove.icon]
-                       "Leave event"]]]])]
-                [:p "You aren't attending any events."])]]
-            [:div.ui.dimmer {:class (when (empty? @events) :active)}
-             [:div.ui.loader]]]])
-        (do
-          (js/location.replace (events-explore-route))
-          [:div])))))
+  (fn []
+    (if (:token @session)
+      (let [attending-events
+            (doall (map (fn [[event-id attendee-id]]
+                          (merge
+                            (into {} (d/entity @events-db event-id))
+                            {:AttendeeId attendee-id}))
+                        (d/q '[:find ?event-id ?attendee-id
+                               :in $ ?user-id
+                               :where
+                               [?attendee-id :UserId  ?user-id]
+                               [?attendee-id :EventId ?event-id]]
+                             @attendees-db
+                             (get-in @session [:user :UserId]))))]
+        [:div.sixteen.wide.column
+         [:div.ui.top.attached.tabular.menu
+          [:a.active.item {:href (events-route)}
+           "Events"]
+          [:a.item {:href (events-explore-route)}
+           "Explore"]
+          [:a.item {:href (events-owned-route)}
+           "Owned"]
+          [:a.item {:href (event-add-route)}
+           "Add"]]
+         [:div.ui.bottom.attached.segment
+          [:div
+           [:div.ui.vertical.segment
+            [:h1.ui.header "Events You're Attending"]]
+           [:div.ui.vertical.segment
+            (if (seq attending-events)
+              [:div.ui.divided.items
+               (for [event attending-events]
+                 ^{:key (:EventId event)}
+                 [:div.item
+                  [:div.content
+                   [:a.header {:href (event-route event)}
+                    (:Name event)]
+                   [:div.meta
+                    [event-details-component event]
+                   [:div.extra
+                    [:a.ui.right.floated.small.button {:href (event-schedule-route event)}
+                     "Your activities"
+                     [:i.right.chevron.icon]]]]]])]
+              [:p "You aren't attending any events."])]]
+          [:div.ui.dimmer {:class (when (empty? @events) "active")}
+           [:div.ui.loader]]]])
+      (do
+        (js/location.replace (events-explore-route))
+        [:div]))))

 (defn events-explore-page []
   (let [unattending-events
@@ -1276,6 +1341,145 @@
       [:div.ui.dimmer {:class (when (empty? @events) :active)}
        [:div.ui.loader]]]]))

+(defn event-details-attendee [event leave-event]
+  (when-let [attendee-id (first (d/q '[:find [?attendee-id ...]
+                                       :in $ ?event-id ?user-id
+                                       :where
+                                       [?attendee-id :EventId ?event-id]
+                                       [?attendee-id :UserId ?user-id]]
+                                     @attendees-db
+                                     (:EventId event)
+                                     (:UserId (:user @session))))]
+    (let [scheduled-activities
+          (d/q '[:find ?schedule-id ?activity-id
+                 :in $activities $schedules ?event-id ?user-id
+                 :where
+                 [$activities ?activity-id :EventId ?event-id]
+                 [$schedules  ?schedule-id :UserId     ?user-id]
+                 [$schedules  ?schedule-id :ActivityId ?activity-id]]
+               @activities-db
+               @schedules-db
+               (:EventId event)
+               (get-in @session [:user :UserId]))]
+      [:div.sixteen.wide.column
+       [:div.ui.segment
+        [:div.ui.vertical.segment
+         [:h1.ui.dividing.header
+          (:Name event)]
+         [event-details-component event]
+         [action-button {:class "right floated small"}
+          [:div
+           [:i.red.remove.icon]
+           "Leave event"]
+          (leave-event attendee-id)]]
+        [:div.ui.vertical.segment
+         [:h2 "QR-Code"]
+         [qr-code
+          {:text (event-attendee-route (into {} (d/entity @attendees-db
+                                                          attendee-id)))}]]
+        [:div.ui.vertical.segment
+         [:h2 "Your Schedule"]
+         [schedule-component scheduled-activities
+          (list "Details" [:i.right.chevron.icon])
+          (fn [_ activity-id]
+            (js/location.replace (event-activity-route {:EventId (:EventId event)
+                                                        :ActivityId activity-id})))
+          [:a.ui.small.right.floated.labeled.icon.button
+           {:href (event-schedule-route event)}
+           [:i.edit.icon]
+           "Edit"]]]]])))
+
+(defn event-details-owner [event activities attendees leave-event]
+  (let [submit-image
+        (fn [e]
+          (.preventDefault e)
+          (let [form-data
+                (doto
+                  (js/FormData.)
+                  (.append "Logo"
+                           (-> (js/jQuery "#file")
+                               (aget 0)
+                               (aget "files")
+                               (aget 0))))]
+            (POST (str api-url-http "/logos")
+                  {:keywords?       true
+                   :timeout         8000
+                   :headers
+                   (if (:token @session)
+                     {:Authentication
+                      (str "Bearer " (:token @session))}
+                     {})
+                   :params form-data
+                   :handler #(prn "success!")
+                   :error-handler #(prn "failed...")})))]
+    [:div.sixteen.wide.column
+     [:div.ui.segment
+      [:div.ui.vertical.segment
+       [:h1.ui.dividing.header
+        (:Name event)]
+       [:div.ui.right.floated.small.labeled.icon.button
+        [:i.edit.icon]
+        "Edit"]
+       [event-details-component event]]
+      (when-let [attendee-id (first (d/q '[:find [?attendee-id ...]
+                                           :in $ ?event-id ?user-id
+                                           :where
+                                           [?attendee-id :EventId ?event-id]
+                                           [?attendee-id :UserId ?user-id]]
+                                         @attendees-db
+                                         (:EventId event)
+                                         (:UserId (:user @session))))]
+        [:div.ui.vertical.segment
+         [:h2 "QR-Code"]
+         [qr-code
+          {:text (event-attendee-route (into {} (d/entity @attendees-db
+                                                          attendee-id)))}]])
+      [:div.ui.vertical.segment
+       [:h2 "Event Logo"]
+       [:form.ui.form
+        [:div.two.fields
+         [:div.field
+          [:label "Choose image"]
+          [:input#file {:type "file"}]]
+         [:div.field]]
+        [:button.ui.primary.button
+         {:type :submit
+          :on-click submit-image}
+         "Submit"]]]
+      [:div.ui.vertical.segment
+       [:h2.ui.header
+        "Activities"]
+       [activity-table-component (:EventId event)]]
+      [:div.ui.vertical.segment
+       [:h2.ui.header
+        "Attendees"
+        [:a.ui.right.floated.small.button
+         {:href (event-attendees-route event)}
+         "View"]]
+       [:table.ui.table
+        [:thead
+         [:tr
+          [:th "Name"]
+          [:th]]]
+        [:tbody
+         (for [attendee attendees]
+           ^{:key (:AttendeeId attendee)}
+           [:tr
+            [:td (str (:FirstName attendee) " " (:LastName attendee))]
+            [:td [:a.ui.right.floated.small.labeled.button
+                  {:href (event-attendee-route {:EventId (:EventId event)
+                                                :AttendeeId (:AttendeeId attendee)})
+                   :class (when (:CheckinTime attendee) :green)}
+                  (if (:CheckinTime attendee)
+                    "Checked in"
+                    "Check in")]]])]
+        [:tfoot
+         [:tr
+          [:th {:colSpan "4"}
+           [:div.ui.right.floated.small.labeled.icon.button
+            [:i.edit.icon]
+            "Edit"]]]]]]]]))
+
 (defn event-page [event-id]
   (let [event (into {} (d/entity @events-db event-id))

@@ -1305,76 +1509,25 @@
                                            [?a :EventId ?event-id]
                                            [?a :UserId ?e]]
                                          @attendees-db
-                                         event-id))))]
+                                         event-id))))
+        leave-event (fn [attendee-id]
+                      (fn [callback]
+                        (attendees-endpoint :delete
+                                            (d/entity @attendees-db attendee-id)
+                                            #(do
+                                               (callback)
+                                               (js/location.replace (events-route))))))]
     (when (seq event)
-      [:div.sixteen.wide.column
-       [:div.ui.segment
-        [:div.ui.vertical.segment
-         [:h1.ui.dividing.header
-          (:Name event)]
-         [:div.ui.right.floated.small.labeled.icon.button
-          [:i.edit.icon]
-          "Edit"]
-         [:div
-          [:b "Date: "]
-          (when (and (:StartDate event)
-                     (:EndDate event))
-            (let [start (from-string (:StartDate event))
-                  end   (from-string (:EndDate   event))]
-              (str (unparse datetime-formatter start)
-                   (when (after? end start)
-                     (str " to "
-                          (unparse datetime-formatter end))))))]
-         [:div
-          [:b "Venue: "] (:Venue event)]
-         [:p (:Description event)]]
-        (when-let [attendee-id (first (d/q '[:find [?attendee-id ...]
-                                             :in $ ?event-id ?user-id
-                                             :where
-                                             [?attendee-id :EventId ?event-id]
-                                             [?attendee-id :UserId ?user-id]]
-                                           @attendees-db
-                                           event-id
-                                           (:UserId (:user @session))))]
-          [:div.ui.vertical.segment
-           [:h2 "QR-Code"]
-           [qr-code
-            {:text (event-attendee-route (into {} (d/entity @attendees-db
-                                                            attendee-id)))}]])
-        [:div.ui.vertical.segment
-         [:h2.ui.header
-          "Activities"]
-         [activity-table-component event-id]]
-        [:div.ui.vertical.segment
-         [:h2.ui.header
-          "Attendees"
-          [:a.ui.right.floated.small.button
-           {:href (event-attendees-route event)}
-           "View"]]
-         [:table.ui.table
-          [:thead
-           [:tr
-            [:th "Name"]
-            [:th]]]
-          [:tbody
-           (for [attendee attendees]
-             ^{:key (:AttendeeId attendee)}
-             [:tr
-              [:td (str (:FirstName attendee) " " (:LastName attendee))]
-              [:td [:a.ui.right.floated.small.labeled.button
-                    {:href (event-attendee-route
-                             {:EventId (:EventId event)
-                              :AttendeeId (:AttendeeId attendee)})
-                     :class (when (:CheckinTime attendee) :green)}
-                    (if (:CheckinTime attendee)
-                      "Checked in"
-                      "Check in")]]])]
-          [:tfoot
-           [:tr
-            [:th {:colSpan "4"}
-             [:div.ui.right.floated.small.labeled.icon.button
-              [:i.edit.icon]
-              "Edit"]]]]]]]])))
+      (if true ;TODO: if owner
+        [event-details-owner event activities attendees leave-event]
+        (if true ;TODO: if attending
+          [event-details-attendee event leave-event]
+          [:div.sixteen.wide.column
+           [:div.ui.segment
+            [:div.ui.vertical.segment
+             [:h1.ui.dividing.header
+              (:Name event)]
+             [event-details-component event]]]])))))

 (defn event-edit-page []
   (let [form (atom {})
@@ -1598,8 +1751,9 @@
           [:div.sixteen.wide.column
            [:div.ui.segment
             [:div.ui.vertical.segment
-             [:h2.ui.header
-              (:Name event)]]
+             [:h2.ui.dividing.header
+              (:Name event)]
+             [event-details-component event]]
             [:div.ui.vertical.segment
              [:h2.ui.header
               (if activity-id "Edit" "Add") " activity"]
@@ -1701,6 +1855,15 @@
              [:h2.ui.header
               "Activities"]
              [activity-table-component event-id]]]])))))
+
+(defn event-activity-page [event-id activity-id]
+  (let [activity (d/entity @activities-db activity-id)]
+    (when (seq activity)
+      [:div.sixteen.wide.column
+       [:div.ui.segment
+        [:div.ui.vertical.segment
+         [:h2.ui.dividing.header (:Name activity)]
+         [activity-details-component activity]]]])))

 (defn event-attendees-page [event-id]
   (let [form (atom {:EventId event-id})]
@@ -2076,7 +2239,7 @@
                               nil))

         remove-activity!
-        (fn [schedule]
+        (fn [schedule _]
           (schedules-endpoint :delete schedule nil))]
     (fn [event-id]
       (let
@@ -2138,42 +2301,9 @@
               (str (get-in @session [:user :FirstName]) "'s Schedule for "
                    (:Name event))]]
             [:div.ui.vertical.segment
-             [:table.ui.table
-              [:thead
-               [:tr
-                [:th "Start"]
-                [:th "End"]
-                [:th "Activity"]
-                [:th "Location"]
-                [:th]]]
-              [:tbody
-               (for [[schedule-id activity-id] scheduled-activities]
-                 ^{:key schedule-id}
-                 (let [activity
-                       (when activity-id
-                         (d/entity @activities-db activity-id))]
-                   [:tr
-                    [:td {:noWrap true}
-                     (when activity
-                       (unparse datetime-formatter
-                                (from-string (:StartTime activity))))]
-                    [:td {:noWrap true}
-                     (when activity
-                       (unparse datetime-formatter
-                                (from-string (:EndTime activity))))]
-                    [:td (:Name activity)]
-                    [:td (:Location activity)]
-                    [:td.right.aligned {:noWrap true}
-                     [:div.ui.button
-                      {:on-click #(remove-activity!
-                                    (d/entity @schedules-db
-                                              schedule-id))}
-                      [:i.red.remove.icon] "Remove"]]]))]
-              [:tfoot
-               [:tr
-                [:th {:colSpan "6"}
-                 [:div.ui.small.labeled.icon.button
-                  [:i.print.icon] "Print"]]]]]]
+             [schedule-component scheduled-activities
+              (list [:i.red.remove.icon] "Remove")
+              remove-activity!]]
             [:div.ui.vertical.segment
              [:div.ui.divided.items
               (for [[activity-id] unscheduled-activities]
@@ -2183,24 +2313,8 @@
                         (d/entity @activities-db activity-id))]
                   [:div.item
                    [:div.content
-                    [:a.header (:Name activity)]
-                    [:div.meta [:strong "Location: "] (:Location activity)]
-                    [:div.meta [:strong "Time: "]
-                     (str (when activity
-                            (unparse datetime-formatter
-                                     (from-string
-                                       (:StartTime activity))))
-                          " - "
-                          (when activity
-                            (unparse datetime-formatter
-                                     (from-string
-                                       (:EndTime activity)))))]
-                    (when (> (:TicketPrice activity) 0)
-                      [:div.meta
-                       [:strong "Ticket Price: "]
-                       (goog.string.format "$%.2f" (:TicketPrice activity))])
-                    [:div.description
-                     (:Description activity)]
+                    [:div.header (:Name activity)]
+                    [activity-details-component activity]
                     [:div.extra
                      (if (> (:TicketPrice activity) 0)
                        [:div.ui.right.floated.button
@@ -2227,24 +2341,8 @@
                            (d/entity @activities-db activity-id))]
                      [:div.item
                       [:div.content
-                       [:a.header (:Name activity)]
-                       [:div.meta [:strong "Location: "] (:Location activity)]
-                       [:div.meta [:strong "Time: "]
-                        (str (when activity
-                               (unparse datetime-formatter
-                                        (from-string
-                                          (:StartTime activity))))
-                             " - "
-                             (when activity
-                               (unparse datetime-formatter
-                                        (from-string
-                                          (:EndTime activity)))))]
-                       (when (> (:TicketPrice activity) 0)
-                         [:div.meta
-                          [:strong "Ticket Price: "]
-                          (goog.string.format "$%.2f" (:TicketPrice activity))])
-                       [:div.description
-                        (:Description activity)]
+                       [:div.header (:Name activity)]
+                       [activity-details-component activity]
                        [:div.extra
                         [:div.ui.right.floated.button
                          {:on-click #(remove-activity-from-cart!


Bug fixes for beta demo.

Bug fixes for beta demo.

--- src/cljs/elevent_client/core.cljs
+++ src/cljs/elevent_client/core.cljs
@@ -959,22 +959,31 @@

 (defn event-edit-page []
   (let [form (atom {})
-        validator (validation-set (presence-of     :Name)
-                                  (presence-of     :OrganizationId)
-                                  (presence-of     :Venue)
-                                  (presence-of     :StartDate)
-                                  (presence-of     :EndDate)
-                                  (numericality-of :TicketPrice))
+        validator (validation-set (presence-of :Name)
+                                  (presence-of :OrganizationId)
+                                  (presence-of :Venue)
+                                  (presence-of :StartDate)
+                                  (presence-of :EndDate)
+                                  (format-of   :TicketPrice :format #"^\d*\.\d\d$"
+                                               :allow-nil true
+                                               :allow-blank true))
         clone-id (atom 0)]
     (add-watch clone-id :clone
                (fn [_ _ _ id]
                  (when-not (zero? (int id))
-                   (reset! form (dissoc (->> id
-                                             int
-                                             (d/entity @events-db)
-                                             seq
-                                             (into {}))
-                                        :EventId)))))
+                   (let [clone-event (->> id
+                                          int
+                                          (d/entity @events-db)
+                                          seq
+                                          (into {}))]
+                     (reset! form (dissoc
+                                    (assoc
+                                      clone-event
+                                      :TicketPrice
+                                      (if (> (:TicketPrice clone-event) 0)
+                                        (goog.string.format "%.2f" (:TicketPrice clone-event))
+                                        ""))
+                                    :EventId))))))
     (fn []
       (let [{:keys [Name OrganizationId Venue StartDate EndDate RequiresPayment TicketPrice Description]}
             @form
@@ -1073,13 +1082,15 @@

 (defn event-activity-edit-page [event-id & [activity-id]]
   (let [form (atom {:EventId event-id})
-        validator (validation-set (presence-of     :Name)
-                                  (presence-of     :StartTime)
-                                  (presence-of     :EndTime)
-                                  (numericality-of :EnrollmentCap))
+        validator (validation-set (presence-of :Name)
+                                  (presence-of :StartTime)
+                                  (presence-of :EndTime)
+                                  (format-of :EnrollmentCap :format #"^\d*$"
+                                             :allow-blank true
+                                             :allow-nil true))
         reset-form!
         (fn []
-          (reset! form (atom {:EventId event-id})))]
+          (reset! form {:EventId event-id}))]
     (when activity-id
       (if-let [activity (seq (d/entity @activities-db activity-id))]
         (reset! form (into {} activity))
@@ -1109,8 +1120,9 @@
                              event-id)))

             create-activity
-            (fn [form]
+            (fn [e form]
               (when (empty? errors)
+                (.preventDefault e)
                 (activities-endpoint :create
                                      (let [start-time (:StartTime form)
                                            end-time   (:EndTime form)]
@@ -1164,7 +1176,7 @@
                 (r/wrap Description swap! form assoc :Description)]]
               [:button.ui.primary.button {:class (when (seq errors) "disabled")
                                           :type :submit
-                                          :on-click #(create-activity @form)}
+                                          :on-click #(create-activity % @form)}
                "Add"]]]
             [:div.ui.vertical.segment
              [:h2.ui.header


Clear board when 'Clear' button is clicked.

--- src/cljs/nonojure/puzzleview.cljs
+++ src/cljs/nonojure/puzzleview.cljs
@@ -239,6 +239,8 @@
       (js/alert (str "There are errors in rows:" rows-wrong "and columns:" cols-wrong)))))

 (defn clear-puzzle []
+  (when-let [state @board]
+    (init-board! board (count (first state)) (count state)))
   (doseq [class ["num-clicked" "cell-clicked" "cell-rightclicked"]
           el (sel (str "." class))]
     (dommy/remove-class! el class)))


Missing deref

Missing deref

--- src/cljs/cglossa/result_views/cwb/speech.cljs
+++ src/cljs/cglossa/result_views/cwb/speech.cljs
@@ -22,8 +22,9 @@
       [(str/trim s-id) [pre match post]])))

 (defn- main-row [result index a {:keys [corpus] :as m}]
-  (let [sound? (:has-sound corpus)
-        video? (:has-video corpus)]
+  (let [corpus* @corpus
+        sound?  (:has-sound corpus*)
+        video?  (:has-video corpus*)]
     ^{:key (hash result)}
     [:tr
      (if (or sound? video?)
@@ -43,8 +44,9 @@
      (shared/text-columns result)]))

 (defn- extra-row [result attr {:keys [corpus]}]
-  (let [sound?       (:has-sound corpus)
-        video?       (:has-video corpus)
+  (let [corpus*      @corpus
+        sound?       (:has-sound corpus*)
+        video?       (:has-video corpus*)
         match        (first (filter (fn [_ v] (:is-match v))
                                     (get-in result [:media-obj :divs :annotation])))
         row-contents (str/join " " (for [[_ v] (:line match)]


Make it possible to use both syntaxes for where statements

--- src/clojure/clojurewerkz/cassaforte/query.clj
+++ src/clojure/clojurewerkz/cassaforte/query.clj
@@ -78,18 +78,22 @@
 ;; Overrides
 ;;

+(defn- transform-ranges
+  [coll]
+  (map (fn [[k v]]
+         (if (sequential? v)
+           [(first v) k (second v)]
+           [k v]))
+       coll))
+
 (defn where
   "Clause: takes a map or a vector of pairs to compose the where
 clause of a select/update/delete query"
   [& args]
   (if (and (= 1 (count args)) (-> args first map?))
-    {:where (first args)}
+    {:where (transform-ranges (first args))}
     {:where (->> (partition 2 args)
-                 (map (fn [[k v]]
-                    (if (sequential? v)
-                      [(first v) k (second v)]
-                      [k v])))
-                 )}))
+                 (transform-ranges))}))

 (defn paginate
   "Paginate through the collection of results


Doubled max points

Doubled max points

--- src/clojush/problems/software/levenshtein.clj
+++ src/clojush/problems/software/levenshtein.clj
@@ -89,7 +89,7 @@
 (def argmap
   {:error-function levenshtein-error
    :atom-generators levenshtein-atom-generators
-   :max-points 1600
+   :max-points 3200
    :max-genome-size-in-initial-program 400
    :evalpush-limit 1600
    :population-size 1000
@@ -110,4 +110,4 @@
    :max-error 5000
    :use-single-thread false
    :reuse-errors false
-   })+   })


Refactored next-generation to eliminate duplication

--- src/conways_game_of_life/grid.clj
+++ src/conways_game_of_life/grid.clj
@@ -42,14 +42,15 @@
      (map
       (fn next-generation-cell
         [cell]
-        (let [live-neighbors-count (live-neighbors-count grid cell)]
+        (let [live-neighbors-count (live-neighbors-count grid cell)
+              live-neighbors-count-equals? (partial = live-neighbors-count)]
           (if (alive? grid cell)
             (cond
              (or
-              (= live-neighbors-count 2)
-              (= live-neighbors-count 3)) 1
+              (live-neighbors-count-equals? 2)
+              (live-neighbors-count-equals? 3)) 1
              :else 0)
-            (if (= 3 live-neighbors-count)
+            (if (live-neighbors-count-equals? 3)
               1
               0))))
       (for [x (range (height grid))


bump re-frisk (#64)

bump re-frisk (#64)

bump re-frisk

--- src/leiningen/new/re_frame/project.clj
+++ src/leiningen/new/re_frame/project.clj
@@ -58,7 +58,7 @@
                    [day8.re-frame/trace "0.1.12"]{{/trace?}}{{#cider?}}
                    [figwheel-sidecar "0.5.13"]
                    [com.cemerick/piggieback "0.2.2"]{{/cider?}}{{#re-frisk?}}
-                   [re-frisk "0.5.0"]{{/re-frisk?}}]
+                   [re-frisk "0.5.3"]{{/re-frisk?}}]

     :plugins      [[lein-figwheel "0.5.13"]{{#test?}}
                    [lein-doo "0.1.8"]{{/test?}}{{#aliases?}}


Clear the physics world during REPL development

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -82,6 +82,13 @@
      :entities entities
      :options options
      :show (fn []
+             ; if using a physics engine in a REPL, we need to forcibly remove
+             ; the entities and world so they are cleaned up properly
+             (when (:world @screen)
+               (update-screen! @screen (reset! entities []))
+               (some-> @screen :world :object .dispose)
+               (update-fn! dissoc [:world]))
+             ; set the initial values in the screen map
              (update-fn! assoc
                          [:total-time 0
                           :update-fn! update-fn!
@@ -89,7 +96,9 @@
                           :on-timer on-timer
                           :input-listeners (input-listeners options execute-fn!)
                           :ui-listeners (ui-listeners options execute-fn!)])
+             ; run :on-show
              (execute-fn! on-show)
+             ; update the physics contact listener if a :world was created
              (some->> (contact-listener @screen options execute-fn!)
                       (vector :contact-listener)
                       (update-fn! assoc)))


Extract make-summary-parts from summarize

--- src/main/clojure/clojure/tools/cli.clj
+++ src/main/clojure/clojure/tools/cli.clj
@@ -345,22 +345,24 @@
         [m (conj errors (str "Unknown option: " (pr-str opt)))]))
     [(default-option-map specs) []] tokens))

+(defn- make-summary-parts [all-boolean? specs]
+  (let [{:keys [short-opt long-opt required default default-desc desc]} specs
+        opt (cond (and short-opt long-opt) (str short-opt ", " long-opt)
+                  long-opt (str "    " long-opt)
+                  short-opt short-opt)
+        [opt dd] (if required
+                   [(str opt \space required)
+                    (or default-desc (if default (str default) ""))]
+                   [opt ""])]
+    (if all-boolean?
+      [opt (or desc "")]
+      [opt dd (or desc "")])))
+
 (defn summarize
   "Reduce options specs into a options summary for printing at a terminal."
   [specs]
   (let [all-boolean? (every? (comp not :required) specs)
-        parts (map (fn [{:keys [short-opt long-opt required default default-desc desc]}]
-                     (let [opt (cond (and short-opt long-opt) (str short-opt ", " long-opt)
-                                     long-opt (str "    " long-opt)
-                                     short-opt short-opt)
-                           [opt dd] (if required
-                                      [(str opt \space required)
-                                       (or default-desc (if default (str default) ""))]
-                                      [opt ""])]
-                       (if all-boolean?
-                         [opt (or desc "")]
-                         [opt dd (or desc "")])))
-                   specs)
+        parts (map (partial make-summary-parts all-boolean?) specs)
         cl-fmt (if all-boolean?
                  "~{  ~vA  ~vA~}"
                  "~{  ~vA  ~vA  ~vA~}")


subscriptions fixes

subscriptions fixes

--- src/re_view/core.cljs
+++ src/re_view/core.cljs
@@ -2,12 +2,20 @@
   (:require-macros re-view.core)
   (:require [cljsjs.react]
             [cljsjs.react.dom]
+            [re-db.core :as d]
             [sablono.core :refer-macros [html]]
             [goog.object :as gobj]))

 (def ^:dynamic *trigger-state-render* true)
 (def ^:dynamic *use-prior* false)
 (def ^:dynamic *use-prior-props* false)
+
+(def db (d/create {:view-id {:db/index true}}))
+
+(defn by-id [id]
+  (d/entity-ids @db [:view-id id]))
+
+(def component-state (atom {}))

 ;; convenience access methods

@@ -43,7 +51,7 @@
   [component name]
   (some-> (.-refs component) (gobj/get name)))

-(def component-state (atom {}))
+

 ;; self-management of cljs props and state

@@ -51,18 +59,14 @@
   "React complains if we mutate props, so we always read from state.
   (this is set in componentWillReceiveProps)"
   [this]
-  (get-in @component-state
-          [this
-           (if (or *use-prior* *use-prior-props*)
-             :prev-props :props)]))
+  (d/get @db this (if (or *use-prior* *use-prior-props*)
+                    :prev-props :props)))

 (defn children [this]
-  (get-in @component-state [this :children]))
+  (d/get @db this :children))

 (defn state [this]
-  (get-in @component-state
-          [this
-           (if *use-prior* :prev-state :state)]))
+  (d/get @db this (if *use-prior* :prev-state :state)))

 ;; State manipulation

@@ -72,9 +76,9 @@
   ;; set-state! always triggers render, unless shouldComponentUpdate returns false.
   ;; if we assume that if state hasn't changed we don't re-render,
   ;; controlled inputs break.
-  (swap! component-state update this #(-> %
-                                          (assoc :prev-state (:state %))
-                                          (assoc :state new-state)))
+  (d/transact! db [{:id         this
+                    :prev-state (d/get @db this :state)
+                    :state      new-state}])
   (when-let [will-receive-state (.-componentWillReceiveState this)]
     (.call will-receive-state this))
   (when (and *trigger-state-render*
@@ -92,7 +96,7 @@
   ([this props & children]
     ;; manually invoke componentWillReceiveProps
    (when-let [will-receive-props (.-componentWillReceiveProps this)]
-     (.call will-receive-props this #js {:cljs$props props
+     (.call will-receive-props this #js {:cljs$props    props
                                          :cljs$children children}))

     ;; only render if shouldComponentUpdate returns true (emulate ordinary React lifecycle)
@@ -118,18 +122,19 @@
              {}
              (.-subscriptions this)))

-(defn begin-subscriptions [this]
+(defn begin-subscriptions [this next-props]
   (doseq [{:keys [subscribe]} (vals (:subscriptions (state this)))]
-    (subscribe)))
-
-(defn end-subscriptions [this]
+    (subscribe next-props)))
+
+(defn end-subscriptions [this prev-props]
   (doseq [{:keys [unsubscribe]} (vals (:subscriptions (state this)))]
-    (unsubscribe)))
+    (unsubscribe prev-props)))

 (defn update-subscriptions [this prev-props next-props]
   (when (seq (keep identity (filter (fn [{:keys [should-update]}] (and should-update (should-update prev-props next-props))) (vals (:subscriptions (state this))))))
     (update-state! this merge (initial-subscription-data this next-props))
-    (begin-subscriptions this)))
+    (end-subscriptions this prev-props)
+    (begin-subscriptions this next-props)))

 (def lifecycle-wrap-fns
   {"getInitialState"
@@ -139,12 +144,12 @@
          (let [initial-props (expand-props this (.. this -props -cljs$props))
                initial-state (merge (when get-initial-state-fn (get-initial-state-fn this initial-props))
                                     (initial-subscription-data this initial-props))]
-           (swap! component-state update this
-                  #(-> %
-                       (assoc :props initial-props)
-                       (assoc :children (.. this -props -cljs$children))
-                       (assoc :state initial-state)
-                       (assoc :prev-state initial-state)))))))
+           (d/transact! db [{:id         this
+                             :props      initial-props
+                             :view-id    (or (:view-id initial-props) (:id initial-props))
+                             :children   (.. this -props -cljs$children)
+                             :state      initial-state
+                             :prev-state initial-state}])))))

    "componentDidMount"
    (fn [f]
@@ -153,52 +158,56 @@
          (binding [*use-prior-props* false
                    *use-prior* false]
            (when f (f this
-                      (get-in @component-state [this :props])
-                      (get-in @component-state [this :state])))))))
+                      (d/get @db this :props)
+                      (d/get @db this :state)))))))

    "componentWillMount"
    (fn [f]
      (fn []
        (this-as this
          (binding [*trigger-state-render* false]
-           (begin-subscriptions this)
+           (begin-subscriptions this (props this))
            (when f (f this))))))

    "componentWillUnmount"
    (fn [f]
      (fn []
        (this-as this
-         (end-subscriptions this)
-         (when f (f this)))))
+         (end-subscriptions this (props this))
+         (when f (f this))
+         (d/transact! db [[:db/retract-entity this]]))))

    "componentWillReceiveState"
    (fn [f]
      (fn []
        (this-as this
-         (let [props (get-in @component-state [this :props])]
+         (let [props (d/get @db this :props)]
            (update-subscriptions this props props)
            (when f
              (f this
                 props
-                (get-in @component-state [this :state])
-                (get-in @component-state [this :prev-state])))))))
+                (d/get @db this :state)
+                (d/get @db this :prev-state)))))))

    "componentWillReceiveProps"
    (fn [f]
      (fn [props]
-       (let [next-props (.-cljs$props props)
-             next-children (.-cljs$children props)]
-         (this-as this
-           (let [next-props (expand-props this next-props)
-                 prev-props (get-in @component-state [this :props])]
-             (swap! component-state update this #(-> %
-                                                     (assoc :prev-props prev-props)
-                                                     (assoc :props next-props)
-                                                     (assoc :children next-children)))
-             (binding [*trigger-state-render* false
-                       *use-prior-props* true]
-               (update-subscriptions this prev-props next-props)
-               (when f (f this prev-props next-props))))))))
+
+       (this-as this
+         (let [prev-props (d/get @db this :props)
+               next-props (expand-props this (.-cljs$props props))
+               next-children (.-cljs$children props)]
+
+           (d/transact! db [{:id         this
+                             :prev-props prev-props
+                             :props      next-props
+                             :view-id    (or (:view-id next-props) (:id next-props))
+                             :children   next-children}])
+
+           (binding [*trigger-state-render* false
+                     *use-prior-props* true]
+             (update-subscriptions this prev-props next-props)
+             (when f (f this prev-props next-props)))))))

    "shouldComponentUpdate"
    (fn [f]
@@ -207,10 +216,10 @@
          (let [update? (if f (binding [*use-prior* true
                                        *trigger-state-render* false]
                                (f this
-                                  (get-in @component-state [this :props])
-                                  (get-in @component-state [this :state])
-                                  (get-in @component-state [this :prev-props])
-                                  (get-in @component-state [this :prev-state])))
+                                  (d/get @db this :props)
+                                  (d/get @db this :state)
+                                  (d/get @db this :prev-props)
+                                  (d/get @db this :prev-state)))
                              ;; by default, update if props or state have changed
                              true)]
            update?))))
@@ -222,28 +231,28 @@
          (when f (binding [*use-prior* true
                            *trigger-state-render* false]
                    (f this
-                      (get-in @component-state [this :props])
-                      (get-in @component-state [this :state])
-                      (get-in @component-state [this :prev-props])
-                      (get-in @component-state [this :prev-state])))))))
+                      (d/get @db this :props)
+                      (d/get @db this :state)
+                      (d/get @db this :prev-props)
+                      (d/get @db this :prev-state)))))))

    "componentDidUpdate"
    (fn [f]
      (fn [_ _]
        (this-as this
          (f this
-            (get-in @component-state [this :props])
-            (get-in @component-state [this :state])
-            (get-in @component-state [this :prev-props])
-            (get-in @component-state [this :prev-state])))))
+            (d/get @db this :props)
+            (d/get @db this :state)
+            (d/get @db this :prev-props)
+            (d/get @db this :prev-state)))))

    "render"
    (fn [f]
      (fn []
        (this-as this
          (let [element (f this
-                          (get-in @component-state [this :props])
-                          (get-in @component-state [this :state]))]
+                          (d/get @db this :props)
+                          (d/get @db this :state))]
            ;; wrap in sablono.core/html if not already a valid React element
            (if (js/React.isValidElement element)
              element
@@ -297,12 +306,12 @@
           {:keys [ref key] :as props} (when props? props)
           element (js/React.createElement
                     class
-                    #js {:key        (or key
-                                         (if-let [keyfn (.. class -prototype -reactKey)]
-                                           (keyfn props) key)
-                                         (.-displayName class))
-                         :ref        ref
-                         :cljs$props (dissoc props :keyfn :ref :key)
+                    #js {:key           (or key
+                                            (if-let [keyfn (.. class -prototype -reactKey)]
+                                              (keyfn props) key)
+                                            (.-displayName class))
+                         :ref           ref
+                         :cljs$props    (dissoc props :keyfn :ref :key)
                          :cljs$children (when (not= '(nil) children) children)})]
       ;;
       #_(set! (.-reactClass element) class)


Follow recent refactoring of AHC.

Follow recent refactoring of AHC.

--- src/http/async/client/request.clj
+++ src/http/async/client/request.clj
@@ -29,7 +29,7 @@
                                  PerRequestConfig
                                  Realm$RealmBuilder Realm$AuthScheme
                                  Request RequestBuilder
-				 RequestType ProxyServer)
+                                 ProxyServer)
            (ahc RequestBuilderWrapper)
            (java.net URLEncoder)
            (java.io InputStream
@@ -47,13 +47,13 @@
   "Converts clj method (:get, :put, ...) to Async Client specific.
    Defaults to :get"
   (cond
-   (= method :get) RequestType/GET
-   (= method :post) RequestType/POST
-   (= method :put) RequestType/PUT
-   (= method :delete) RequestType/DELETE
-   (= method :head) RequestType/HEAD
-   (= method :options) RequestType/OPTIONS
-   :default RequestType/GET))
+   (= method :get) "GET"
+   (= method :post) "POST"
+   (= method :put) "PUT"
+   (= method :delete) "DELETE"
+   (= method :head) "HEAD"
+   (= method :options) "OPTIONS"
+   :default "GET"))

 (defn get-encoding
   "Gets content encoding from headers, if Content-Type header not present


Adds text fields for all sets

Adds text fields for all sets

--- src/hundred_pushups/ios/core.cljs
+++ src/hundred_pushups/ios/core.cljs
@@ -13,6 +13,7 @@
 (def text-input (r/adapt-react-class (.-TextInput ReactNative)))
 (def view (r/adapt-react-class (.-View ReactNative)))
 (def image (r/adapt-react-class (.-Image ReactNative)))
+(def scroll-view (r/adapt-react-class ReactNative.ScrollView))
 (def touchable-highlight (r/adapt-react-class (.-TouchableHighlight ReactNative)))

 (def pushup-form-url "http://www.100pushups.com/perfect-pushups-posture/")
@@ -50,6 +51,7 @@
        [text {} "Reps:"]
        [text-input {:style {:height 40 :border-color "grey" :border-width 1}
                     :default-value (:pushup-reps-text @ui-state)
+                    :keyboard-type "numeric"
                     :on-change-text (fn [text]
                                  (dispatch [:ui-state/set [:pushup-reps-text] text])
                                       (dispatch [:db/save]))}]
@@ -68,9 +70,10 @@
        [text {:style {:text-align "center"}} "Stop when your form starts to get bad (e.g. sagging body)"]
        [text {} "Plank breadths:"]
        [text-input {:style {:height 40 :border-color "grey" :border-width 1}
+                    :keyboard-type "numeric"
                     :default-value (:plank-reps-text @ui-state)
                     :on-change-text (fn [text]
-                                 (dispatch [:ui-state/set [:plank-reps-text] text])
+                                      (dispatch [:ui-state/set [:plank-reps-text] text])
                                       (dispatch [:db/save]))}]
        [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5 :margin 10}
                              :on-press #(do
@@ -98,17 +101,31 @@
    [text {:style {:font-size 20 :font-weight "100" :margin-bottom 10 :text-align "center"}} "Today's exercise"]
    (let [schedule @(subscribe [:days-exercise])
          circuit (:exr/circuit schedule)]
-     [view {}
-      (for [x (range (:exr/sets schedule))]
-        [view {:key x}
-         [text {:style {:font-size 18 :font-weight "600" :margin-top 10}} (str "Set" x)]
-         [text {} (str (:exr/pushup-reps circuit) " pushups")]
-         [text {} (str "Hold plank for "(:exr/plank-reps circuit) " breaths")]])
+     [view {:style {:height 350 :width 250 :padding 20 :background-color "lightgrey"}}
+      [scroll-view {:style {:flex 1}}
+       (for [x (range (:exr/sets schedule))]
+         [view {:key x}
+          [text {:style {:font-size 18 :font-weight "600" :margin-top 10}} (str "Set" x)]
+          [text {} (str (:exr/pushup-reps circuit) " pushups")]
+          [text-input {:style {:height 40 :border-color "grey" :border-width 1}
+                       :default-value (str (:exr/pushup-reps circuit))
+                       :keyboard-type "numeric"
+                       :on-change-text (fn [text]
+                                         (dispatch [:ui-state/set [:pushup-reps-text x] text])
+                                         (dispatch [:db/save]))}]
+          [text {} (str "Hold plank for "(:exr/plank-reps circuit) " breaths")]
+          [text-input {:style {:height 40 :border-color "grey" :border-width 1}
+                       :default-value (str (:exr/plank-reps circuit))
+                       :keyboard-type "numeric"
+                       :on-change-text (fn [text]
+                                         (dispatch [:ui-state/set [:plank-reps-text x] text])
+                                         (dispatch [:db/save]))}]])]
       [touchable-highlight {:style {:background-color "#999" :padding 10 :border-radius 5 :margin-top 20}
                             :on-press #(do
                                          (dispatch [:complete-day schedule])
                                          (dispatch [:db/save]))}
-       [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "I did it"]]])])
+       [text {:style {:color "white" :text-align "center" :font-weight "bold"}} "Done!"]]]
+     )])

 (defn app-root []
   (let [stage (subscribe [:stage])]


cleaning up names in algorithm.clj

cleaning up names in algorithm.clj

--- src/lcmap/clownfish/algorithm.clj
+++ src/lcmap/clownfish/algorithm.clj
@@ -37,8 +37,8 @@

 (defn get-conf
   "Retrieve algorithm configuration or nil"
-  [^String algorithm-name]
-  (->> (hayt/where [[= :algorithm algorithm-name]])
+  [algorithm]
+  (->> (hayt/where [[= :algorithm algorithm]])
        (hayt/select :algorithms)
        (db/execute)
        (first)))
@@ -52,7 +52,7 @@
   "Enables an algorithm in the system."
   ;;; TODO - Autodeploy mesos dockerimage, make sure dockerimage exists
   ;;; server queue & exchange are created when the listener starts in server.clj
-  [^String algorithm]
+  [algorithm]
   (let [[queue exchange] ((juxt event/create-queue
                                 event/create-exchange) algorithm)
         server-exchange (get-in config [:server :exchange])
@@ -66,7 +66,7 @@

 (defn disable
   "Disables an algorithm in the system"
-  [^String algorithm]
+  [algorithm]
   (->> algorithm
        (event/destroy-exchange)
        (event/destroy-queue)))
@@ -83,7 +83,7 @@
 (defn inputs
   "Construct url to retrieve tiles for algorithm input"
   [{:keys [x y algorithm] :as data}]
-  (let [conf  (get-conf (:algorithm data))
+  (let [conf  (get-conf algorithm)
         now   (tc/to-string (time/now))]
     (template/render (:inputs_url_template conf) (merge data {:now now}))))

@@ -95,12 +95,12 @@

 (defn get-algorithm
   "Returns an algorithm if defined in the system."
-  [^String algorithm-name]
-  (log/debugf "get-algorithm: %s..." algorithm-name)
-  (let [result (get-conf algorithm-name)]
+  [algorithm]
+  (log/debugf "get-algorithm: %s..." algorithm)
+  (let [result (get-conf algorithm)]
     (if result
       {:status 200 :body result}
-      {:status 404 :body (str algorithm-name " not found.")})))
+      {:status 404 :body (str algorithm " not found.")})))

 (defn put-algorithm
   "Updates or creates an algorithm definition"


加入一些新内容

加入一些新内容

--- src/learnclojure/chapt3/core5.clj
+++ src/learnclojure/chapt3/core5.clj
@@ -147,6 +147,32 @@
       (compare a b)
       diff)))
 (sorted-set-by compare-magnitude 10 1000 500)
+;;=#{10 500 1000}
+(conj *1 600)
+;;=#{10 500 600 1000}
+(disj *1 750)
+;;=#{10 500 600 1000}
+;;现在集合中的值按照10的量级排序了，同时那些只依赖数字相等性的操作(如conj和disj)的结果和我们预期的一样
+
+;;subseq和rsubseq也能继续按照比较器锁定义的顺序正常截取集合的一段
+(sorted-set-by compare-magnitude 10 1000 500 670 1239)
+;;=#{10 500 670 1000 1239}
+(def ss *1)
+(subseq ss > 669)
+;;=(670 1000 1239)
+(subseq ss > 670 <= 1000)
+;;=(1000)
+(rsubseq ss > 500 <= 1000)
+;;=(1000 670)
+;;我们提拔方法>、>=、<、<=来指定需要的元素区间，其他比较器也是可以的
+
+;;应用：线性牛顿插值
+(def m (into (sorted-map) (map vec [[0 0] [10 10] [15 5]])))
+(rsubseq m <= 2)
+(subseq m > 2)

+
+
+


shadow-cljs pom should account for maven repositories

fixes #939

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -672,17 +672,42 @@
                   [:name project-name]

                   ;; FIXME: need config for this at some point, defaults from lein
-                  [:repositories
-                   [:repository
-                    [:id "central"]
-                    [:url "https://repo1.maven.org/maven2/"]
-                    [:snapshots [:enabled "false"]]
-                    [:releases [:enabled "true"]]]
-                   [:repository
-                    [:id "clojars"]
-                    [:url "https://repo.clojars.org/"]
-                    [:snapshots [:enabled "true"]]
-                    [:releases [:enabled "true"]]]]
+                  (into
+                    [:repositories
+                     [:repository
+                      [:id "central"]
+                      [:url "https://repo1.maven.org/maven2/"]
+                      [:snapshots [:enabled "false"]]
+                      [:releases [:enabled "true"]]]
+                     [:repository
+                      [:id "clojars"]
+                      [:url "https://repo.clojars.org/"]
+                      [:snapshots [:enabled "true"]]
+                      [:releases [:enabled "true"]]]]
+
+                    (comp
+                      (map (fn [[id info]]
+                             (cond
+                               (string? info)
+                               [:repository
+                                [:id id]
+                                [:url info]
+                                [:snapshots [:enabled "true"]]
+                                [:releases [:enabled "true"]]]
+
+                               (map? info)
+                               [:repository
+                                [:id id]
+                                [:url (:url info)]
+                                [:snapshots [:enabled "true"]]
+                                [:releases [:enabled "true"]]]
+
+                               :else
+                               nil)))
+                      (remove nil?))
+
+                    (or (get-in config [:maven :repositories])
+                        (get-in config [:user-config :maven :repositories])))

                   (->> (into [['thheller/shadow-cljs jar-version]] dependencies)
                        (map (fn [[dep-sym dep-version & more]]


add has-count-that

add has-count-that

--- src/matcha.clj
+++ src/matcha.clj
@@ -185,6 +185,13 @@
   [n]
   (on count (= n) "count" "a collection"))

+(defn has-count-that
+  "passes if the sequence received has the given count
+  (matcha/run-match (matcha/has-count-that (matcha/= 1)) [1]) ; => passes
+  (matcha/run-match (matcha/has-count-that (matcha/= 1)) [])  ; => fails"
+  [m]
+  (on count m "count" "a collection"))
+
 (defn has-nth
   "passes if the sequence received has the value matching the matcher given at
   (nth n)


Now returns a map if there's an error in missing required keys or incorrect choice.

--- src/onyx_java/utility/interop.clj
+++ src/onyx_java/utility/interop.clj
@@ -16,7 +16,8 @@
   :name onyx-java.IPipeline
   :methods [[writeBatch [clojure.lang.IPersistentMap] clojure.lang.IPersistentMap]])

-(defn boolean-string [y] (if (= (type y) java.lang.String) (read-string y) y))
+(defn boolean-string [x]
+    (if (= (type x) java.lang.String) (read-string x) x))

 (def casts
   {:boolean (fn [x] (boolean (boolean-string x)))
@@ -28,7 +29,11 @@

 (defn check-choices [choices value]
     (if (boolean (some #{:all} (flatten choices))) value
-        (if (some #{value} choices) value (throw (Exception. "Not a valid choice.")))))
+        (if (some #{value} choices)
+            value
+            "CHOICE-ERROR"
+            ;(throw (Exception. "Not a valid choice."))
+            )))

 (defn get-required-keymap [section]
     (let [required-keys (vec (keys (filter (fn [[k v]] (and (-> v :optional? not)
@@ -37,22 +42,33 @@
      (apply merge (map #(hash-map % nil) required-keys))))

 (defn update-required-keymap [required-keymap keyword]
-    ;(println keyword)
-    (if (boolean (some #{keyword} (keys required-keymap))) (assoc required-keymap keyword true) required-keymap))
+    (if (boolean (some #{keyword} (keys required-keymap)))
+        (assoc required-keymap keyword true)
+        required-keymap))
+
+(defn required-keywords [required existing]
+    (let [missing (clojure.set/difference (set (keys required)) (set (keys existing)))]
+    (if (= 0 (count missing))
+        nil
+        missing)))

 (defn cast-types [section m]
-  (let [section* (keyword section)]
-        ;required-keymap (get-required-keymap section*)]
-    (reduce-kv
-     (fn [m* k v]
-       (let [k* (keyword k)
-             type (get-in model [section* :model k* :type])
-             choices (get-in model [section* :model k* :choices] [:all])
-             required (not (get-in model [section* :model k* :optional?] true))
-             v* (check-choices choices ((get casts type identity) v))]
-         (assoc m* k* v*)))
-     {}
-     m)))
+  (let [section* (keyword section)
+        required-keymap (get-required-keymap section*)
+        new-map (reduce-kv
+                    (fn [m* k v]
+                        (let [k* (keyword k)
+                        type (get-in model [section* :model k* :type])
+                        choices (get-in model [section* :model k* :choices] [:all])
+                        v* (check-choices choices ((get casts type identity) v))]
+                        (assoc m* k* v*)))
+                    {}
+                    m)]
+    (def missing (required-keywords required-keymap new-map))
+    (if (not missing)
+        new-map
+        (apply merge (map #(hash-map % "KEY-ERROR") missing))
+    )))

 (defn coerce-workflow [workflow]
   (mapv #(mapv (fn [v] (keyword v)) %) workflow))


FIX regresion

FIX regresion

--- webui/src/webui/routes/api.clj
+++ webui/src/webui/routes/api.clj
@@ -34,7 +34,6 @@
 (defn save-workspace [workspace]
   (info (yaml/parse-string (json/parse-string workspace))))

-
 (defn load-workspace []
   (json-response "hola"))


Fix default value handling.

Fix default value handling.

--- src/bide/core.cljs
+++ src/bide/core.cljs
@@ -81,31 +81,34 @@

 (defn start!
   "Starts the bide routing handling using the goog.History
-  api for browser history event watching mechanism."
+  api as browser history event watching mechanism."
   [router {:keys [on-navigate default] :as opts}]
-  (letfn [(-on-navigate [event]
-            (let [[name params] (-match (.-token event))]
-              (on-navigate name params)))
-          (-match [token]
-            (or (match router token) [default nil]))
-          (-initial-token [history]
-            (let [token (.getToken history)]
-              (if-not (str/blank? token)
-                token
-                (or (resolve (:name default) (:params default)) "/"))))]
-
-  (let [history (doto (History.) (.setEnabled true))
-        initial-token (-initial-token history)
-        initial-loc (-match initial-token)]
-    (e/listen history History.EventType.NAVIGATE -on-navigate)
-    (.replaceToken history initial-token)
-    (on-navigate initial-loc)
-    (specify! router
-      IRouter
-      (-navigare [_ location params]
-        (.setToken history (resolve location params)))
-      (-replace-location [_ location params]
-        (.replaceToken history (resolve location params)))))))
+  (let [default (if (vector? default) default [default nil])]
+    (letfn [(-on-navigate [event]
+              (let [[name params] (-match (.-token event))]
+                (on-navigate name params)))
+            (-match [token]
+              (let [result (match router token)]
+                (or result default)))
+            (-initial-token [history]
+              (let [token (.getToken history)]
+                (if (str/blank? token)
+                  (or (apply resolve router default) "/")
+                  token)))]
+      (let [history (doto (History.) (.setEnabled true))
+            initial-token (-initial-token history)
+            initial-loc (-match initial-token)]
+        (e/listen history History.EventType.NAVIGATE -on-navigate)
+        (.replaceToken history initial-token)
+        (js/setTimeout #(apply on-navigate initial-loc) 0)
+        (specify! router
+          IRouter
+          (-navigare [_ location params]
+            (when-let [path (resolve router location params)]
+              (.setToken history path)))
+          (-replace-location [_ location params]
+            (when-let [path (resolve router location params)]
+              (.replaceToken history path))))))))

 (defn navigate!
   "Trigger a navigate event to a specific location."


Work around known TANAL/TEJVM bug

Work around known TANAL/TEJVM bug

At present TANAL/TEJVM can't handle the Clojure core correctly. This
patch, while jank at best, works around this failure so that I can
continue analyzing and testing against whole program ASTs including the
Clojure core.

--- src/oxcart.clj
+++ src/oxcart.clj
@@ -117,13 +117,8 @@
                                                 (.name *ns*))))))))

              ;; Run the code for side-effects
-
-             ;; FIXME: Loading core
-             ;;   This will happly eval clojure.core code, which tends
-             ;;   to break things. Should probably get a patch to
-             ;;   escape reloading and breaking core until Oxcart is
-             ;;   self-hosting.
-             (when eval?
+             (when (and eval?
+                        (not (= 'clojure.core (.name *ns*))))
                (em.jvm/eval mform)))))))


Add docs and tweak license formatting

Add docs and tweak license formatting

--- src/oxcart.clj
+++ src/oxcart.clj
@@ -1,4 +1,4 @@
-;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors.  The use
+;;   Copyright (c) Reid McKenzie, Rich Hickey & contributors. The use
 ;;   and distribution terms for this software are covered by the
 ;;   Eclipse Public License 1.0
 ;;   (http://opensource.org/licenses/eclipse-1.0.php) which can be
@@ -8,6 +8,9 @@
 ;;   notice, or any other, from this software.

 (ns oxcart
+  {:doc "Implementation of the Oxcart compiler & API."
+   :added "0.0.1"
+   :author "Reid McKenzie"}
   (:refer-clojure :exclude [eval macroexpand-1 macroexpand load compile])
   (:require [clojure.tools.analyzer.jvm :as ana.jvm]
             [clojure.tools.analyzer


updated topology for sample crawler.  crawler output not connected

--- memex-datawake-stream/topologies/dw-jvm-kafka.clj
+++ memex-datawake-stream/topologies/dw-jvm-kafka.clj
@@ -91,7 +91,7 @@
                options
                { "website-bolt" ["value"] }
                "bolts.crawler_bolt.CrawlerBolt"
-               []
+               ["url", "status", "headers", "flags", "body", "timestamp", "source","context"]
                )

     "email-bolt" (python-bolt-spec


(maint) Make connectivity check timeout configurable

Setting this in wrap-with-delayed-init was making it impossible to configure
independently. Since the datasource's regular connection timeout is already
the default, this also served no purpose. Remove it and add a utility function
for setting the timeout.

--- src/puppetlabs/jdbc_util/pool.clj
+++ src/puppetlabs/jdbc_util/pool.clj
@@ -50,6 +50,11 @@
   (status [this] "Get a map representing the status of a connection pool.")
   (init-error [this] "Return any exception raised by the init function (nil if none)."))

+(defn add-connectivity-check-timeout-ms
+  [hikari-config timeout]
+  (.addHealthCheckProperty hikari-config "connectivityCheckTimeoutMs" (str timeout))
+  hikari-config)
+
 (defn wrap-with-delayed-init
   "Wraps a connection pool that loops trying to get a connection, and then runs
   init-fn (with the connection as argument) before returning any connections to
@@ -58,7 +63,6 @@
   initialization-fail-fast set before being created or this is pointless."
   [^HikariDataSource datasource init-fn timeout]
   (when-not (.getHealthCheckRegistry datasource)
-    (.addHealthCheckProperty datasource "connectivityCheckTimeoutMs" (str timeout))
     (.setHealthCheckRegistry datasource (HealthCheckRegistry.)))
   (let [init-error (atom nil)
         pool-future


simplify the create-url transformer fn

simplify the create-url transformer fn

--- frontend/history.cljs
+++ frontend/history.cljs
@@ -23,10 +23,7 @@

     (set! (.-createUrl transformer)
           (fn [token path-prefix location]
-            (let [[path hash] (string/split token #"#")]
-              (str path-prefix
-                   path
-                   (when hash (str "#" hash))))))
+            (str path-prefix token)))

     transformer))


fix bug with derivative ids that dont implement IFn

--- src/org/martinklepsch/derivatives.cljc
+++ src/org/martinklepsch/derivatives.cljc
@@ -51,7 +51,7 @@
     (when (satisfies? derived/IDisposable drv-val)
       (derived/dispose! drv-val)))
   (reduce (fn [m k]
-            (let [[direct-deps derive] (-> spec k)]
+            (let [[direct-deps derive] (get spec k)]
               (if (get m k)
                 m
                 (if (watchable? derive)


Add proper helpers for http client.

Add proper helpers for http client.

--- test/uxbox/tests/helpers.clj
+++ test/uxbox/tests/helpers.clj
@@ -41,6 +41,62 @@
                 (sz/decode :transit+json))]
     [status body]))

+(defn http-get
+  ([uri]
+   (http-get nil uri))
+  ([user uri]
+   (let [headers (when user
+                   {"Authorization" (str "Token " (usa/generate-token user))})
+         params {:headers headers}]
+     (try
+       (strip-response (http/get uri params))
+       (catch clojure.lang.ExceptionInfo e
+         (strip-response (ex-data e)))))))
+
+(defn http-post
+  ([uri params]
+   (http-post nil uri params))
+  ([user uri {:keys [body] :as params}]
+   (let [body (-> (sz/encode body :transit+json)
+                  (codecs/bytes->str))
+         headers (merge
+                  {"content-type" "application/transit+json"}
+                  (when user
+                    {"Authorization" (str "Token " (usa/generate-token user))}))
+         params {:headers headers :body body}]
+     (try
+       (strip-response (http/post uri params))
+       (catch clojure.lang.ExceptionInfo e
+         (strip-response (ex-data e)))))))
+
+(defn http-put
+  ([uri params]
+   (http-put nil uri params))
+  ([user uri {:keys [body] :as params}]
+   (let [body (-> (sz/encode body :transit+json)
+                  (codecs/bytes->str))
+         headers (merge
+                  {"content-type" "application/transit+json"}
+                  (when user
+                    {"Authorization" (str "Token " (usa/generate-token user))}))
+         params {:headers headers :body body}]
+     (try
+       (strip-response (http/put uri params))
+       (catch clojure.lang.ExceptionInfo e
+         (strip-response (ex-data e)))))))
+
+(defn http-delete
+  ([uri]
+   (http-delete nil uri))
+  ([user uri]
+   (let [headers (when user
+                   {"Authorization" (str "Token " (usa/generate-token user))})
+         params {:headers headers}]
+     (try
+       (strip-response (http/delete uri params))
+       (catch clojure.lang.ExceptionInfo e
+         (strip-response (ex-data e)))))))
+
 (defn post
   [uri body]
   (let [body (-> (sz/encode body :transit+json)


Check bcrypt version of password before sha1.

--- src/clojars/db.clj
+++ src/clojars/db.clj
@@ -5,7 +5,8 @@
             [clojure.java.jdbc :as sql])
   (:import java.security.MessageDigest
            java.util.Date
-           java.io.File))
+           java.io.File
+           org.mindrot.jbcrypt.BCrypt))

 (def ^{:private true} ssh-options
   "no-agent-forwarding,no-port-forwarding,no-pty,no-X11-forwarding")
@@ -78,10 +79,14 @@
   (sql/with-query-results rs ["select * from groups where name like ?" group]
     (doall (map :user rs))))

-(defn auth-user [user pass]
+(defn authed? [given-password user]
+  (or (BCrypt/checkpw given-password (:password user))
+      (= (:password user) (sha1 (:salt user) given-password))))
+
+(defn auth-user [user given-password]
   (sql/with-query-results rs
       ["select * from users where (user = ? or email = ?)" user user]
-    (first (filter #(= (:password %) (sha1 (:salt %) pass)) rs))))
+    (first (filter (partial authed? given-password) rs))))

 (defn jars-by-user [user]
   (sql/with-query-results rs [(str "select * from jars where user = ? "


Test for the function data-series-for-line-chart

--- test/clj_flotr/generator_test.clj
+++ test/clj_flotr/generator_test.clj
@@ -152,3 +152,9 @@
             (data-series-for-pie-chart [{:values :v1 :label nil}])
                                        ["{data:[[1,:v1]], label: ''},\n"])))

+(deftest test-data-series-for-line-chart-1
+    (testing "Test the function data-series-for-line-chart"
+        (are [x y] (= x y)
+            (data-series-for-line-chart nil) '()
+            (data-series-for-line-chart [])  '())))
+


moved tests in test/cmr/ingest/test/concepts.clj to cmr-sys-int-test.

--- test/cmr/ingest/test/concepts.clj
+++ test/cmr/ingest/test/concepts.clj
@@ -1,82 +0,0 @@
-(ns cmr.ingest.test.concepts
-  (:require [clojure.test :refer :all]
-            [cmr.common.log :as log :refer (debug info warn error)]
-            [clj-http.client :as client]
-            [cheshire.core :as cheshire])
-  (:use [slingshot.slingshot :only [throw+ try+]]))
-
-(defn concept
-  "Creates a sample concept."
-  [provider-suffix-num]
-  {:concept-type :collections
-   :native-id "nativeId1"
-   :provider-id (str "PROV" provider-suffix-num)
-   :metadata "xml here"
-   :format "iso19115"})
-
-(defn construct-ingest-rest-url
-  "Construct ingest url based on concept."
-  [concept]
-  (let [host "localhost"
-        port 3002
-        {:keys [provider-id concept-type native-id ]} concept
-        ctx-part (str "providers" "/" provider-id  "/" (name concept-type) "/" native-id )
-        ingest-rest-url (str "http://" host ":" port "/" ctx-part)]
-    ingest-rest-url))
-
-(defn save-concept
-  "Make a put request to ingest a concept without JSON encoding the concept.  Returns a map with
-  status, revision-id, and a list of error messages"
-  [concept]
-  (let [coerced-json-str (cheshire/generate-string concept)
-        response (client/request
-                   {:method :put
-                    :url (construct-ingest-rest-url concept)
-                    :body  coerced-json-str
-                    :body-encoding "UTF-8"
-                    :content-type :json
-                    :accept :json
-                    :throw-exceptions true})
-        status (:status response)
-        body (cheshire/parse-string (:body response))
-        revision-id (get body "revision-id")
-        error-messages (get body "errors")]
-    {:status status :revision-id revision-id :error-messages error-messages}))
-
-(def provider-suffix-num-atom (atom (rand-int 1000000)))
-
-;;; tests
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(deftest concept-ingest-test
-  "Save a valid concept with no revision-id."
-  (swap! provider-suffix-num-atom inc)
-  (try+
-    (let [{:keys [status revision-id]} (save-concept (concept @provider-suffix-num-atom))]
-      (is (and (= status 201) (= revision-id 0))))
-    (catch Exception e
-      (error "Exception occurred while executing concept-ingest-test: " (.getMessage e))
-      (.printStackTrace e)
-      (is false))
-    (catch Object o
-      (error (:throwable &throw-context) "Unexpected error occurred while executing concept-ingest-test.")
-      (print o)
-      (is false))))
-
-(deftest repeat-same-concept-ingest-test
-  "Ingest same concept N times and verify it is in metadata db with revision id value 'N - 1'."
-  (swap! provider-suffix-num-atom inc)
-  (try+
-    (let [N 4
-          expected-revision-id (- N 1)
-          last-revision-id (last (repeatedly N
-                                             #(let [ {:keys [revision-id]} (save-concept (concept @provider-suffix-num-atom))]
-                                                revision-id)))]
-      (is (= expected-revision-id last-revision-id)))
-    (catch Exception e
-      (error "Exception occurred while executing repeat-same-concept-ingest-test: " (.getMessage e))
-      (.printStackTrace e)
-      (is false))
-    (catch Object o
-      (error (:throwable &throw-context) "Unexpected error occurred while executing repeat-same-concept-ingest-test.")
-      (print o)
-      (is false))))


Split metrics/version/command out of api.clj and into their own namespaces

--- test/com/puppetlabs/test/http.clj
+++ test/com/puppetlabs/test/http.clj
@@ -1,12 +1,12 @@
 (ns com.puppetlabs.test.http
+  (:import [java.io InputStream StringWriter])
   (:require [clj-http.client :as client]
             [cheshire.core :as json]
             [puppetlabs.trapperkeeper.testutils.jetty :refer [with-test-jetty]]
             [ring.mock.request :as mock])
-  (:import [java.io InputStream StringWriter])
   (:use [com.puppetlabs.http]
         [clojure.test]
-        [cheshire.core])
+        [cheshire.core]))

 (deftest conneg
   (testing "content negotiation"


Fix errors when running tests

Fix errors when running tests

--- test/testing/plan_schema/core.clj
+++ test/testing/plan_schema/core.clj
@@ -11,7 +11,8 @@
             [clojure.test :refer [deftest testing is]]
             [clojure.pprint :refer [pprint]]
             [plan-schema.core :as pschema]
-            [plan-schema.cli :as cli]))
+            [plan-schema.cli :as cli]
+            [plan-schema.utils :as utils]))

 (deftest working-directory
   (testing "Current Working Directory"
@@ -61,9 +62,9 @@
     (let [json-str "{\"a\":123}"]
       (is (= json-str
              (-> json-str
-                 (pschema/read-json-str)
-                 (pschema/write-json-str)
+                 (utils/read-json-str)
+                 (utils/write-json-str)
                  (string/trim-newline)))))
-    (= {} (pschema/read-json-str "{}"))
-    (= {:a 123 :m {"string" "value"}} (pschema/read-json-str "{\"a\": 123, \"m\": {\"string\": \"value\"}}"))
+    (= {} (utils/read-json-str "{}"))
+    (= {:a 123 :m {"string" "value"}} (utils/read-json-str "{\"a\": 123, \"m\": {\"string\": \"value\"}}"))
     ))


Extend repo function to also allow initialising with fixture data

--- src/rdf-repository/grafter/rdf/repository.clj
+++ src/rdf-repository/grafter/rdf/repository.clj
@@ -24,6 +24,7 @@
            (org.openrdf.repository.http HTTPRepository)
            (org.openrdf.repository.sail SailRepository)
            (org.openrdf.repository.sparql SPARQLRepository)
+           (org.openrdf.sail Sail)
            (org.openrdf.sail.memory MemoryStore)
            (org.openrdf.sail.nativerdf NativeStore)
            (info.aduna.iteration CloseableIteration)
@@ -187,11 +188,32 @@
    (CustomGraphQueryInferencer. notifying-sail QueryLanguage/SPARQL query-text matcher-text)))

 (defn repo
-  "Given a sesame Store of some type, return a sesame SailRepository."
+  "Given a sesame Store of some type, return a sesame SailRepository.
+
+  This function also supports initialising the repository with some
+  data that can be loaded from anything grafter.rdf/statements can
+  coerce.  Additionally the data can also be a sequence of
+  grafter.rdf.protocols/Quad's.
+
+  Finally you can also optionally supply a sesame sail to wrap the
+  repository, which can be used to configure a sesame NativeStore.
+
+  By default this function will return a repository initialised with a
+  Sesame MemoryStore."
   ([] (repo (MemoryStore.)))
-  ([store]
-     (doto (SailRepository. store)
-       (.initialize))))
+  ([sail-or-rdf-file]
+   (if (instance? Sail sail-or-rdf-file)
+     (repo nil sail-or-rdf-file)
+     (repo sail-or-rdf-file (MemoryStore.))))
+
+  ([rdf-data sail]
+   (let [r (doto (SailRepository. sail)
+             (.initialize))]
+     (pr/add r (cond
+                 (and rdf-data (satisfies? io/Coercions rdf-data)) (pr/to-statements rdf-data {})
+                 (or (seq rdf-data) (nil? rdf-data)) rdf-data))
+
+     r)))

 (defn- query-bindings->map [^BindingSet qbs]
   (let [boundvars (.getBindingNames qbs)]


fixed lazy bug in compute-total-error

fixed lazy bug in compute-total-error

--- src/clojush.clj
+++ src/clojush.clj
@@ -1805,7 +1805,7 @@

 (defrecord individual [program errors total-error history ancestors])

-(defn make-individual [& {:keys [program errors total-error history ancestors]
+(defn make-individual [& {:keys [program errors total-error adjusted-error history ancestors]
                           :or {program nil
                                errors nil
                                total-error nil ;; a non-number is used to indicate no value
@@ -1816,9 +1816,9 @@
 (defn compute-total-error
   [errors]
   (if @global-use-historically-assessed-hardness
-    (reduce + (map (fn [rate e] (* (- 1.01 rate) e))
-                   @solution-rates
-                   errors))
+    (reduce + (doall (map (fn [rate e] (* (- 1.01 rate) e))
+                          @solution-rates
+                          errors)))
     (reduce + errors)))

 (defn choose-node-index-with-leaf-probability


first->lrand-nth in lexicase-selection

first->lrand-nth in lexicase-selection

--- src/clojush.clj
+++ src/clojush.clj
@@ -2096,7 +2096,7 @@
          cases (shuffle (range (count (:errors (first pop)))))]
     (if (or (empty? cases)
             (empty? (rest survivors)))
-      (first survivors)
+      (lrand-nth survivors)
       (let [min-err-for-case (apply min (map #(nth % (first cases))
                                              (map #(:errors %) survivors)))]
         (recur (filter #(= (nth (:errors %) (first cases)) min-err-for-case)


Change order of arguments in anagram script

--- clojure/anagrams.clj
+++ clojure/anagrams.clj
@@ -1,14 +1,14 @@
 (defn swap [a i j]
-   (assoc a j (a i) i (a j)))
+  (assoc a j (a i) i (a j)))

-(defn generatePermutations [n v]
+(defn generatePermutations [v n]
   (if (zero? n)
     (println (apply str v))

     (loop [i 0 a v]
       (if (<= i n)
         (do
-          (generatePermutations (dec n) a)
+          (generatePermutations a (dec n))
           (recur (inc i) (swap a (if (even? n) i 0) n)))))))

 (if (not= (count *command-line-args*) 1)
@@ -16,4 +16,4 @@
     (println "Exactly one argument is required")
     (System/exit 1))
   (let [word (-> *command-line-args* first vec)]
-    (generatePermutations (dec (count word)) word)))
+    (generatePermutations word (dec (count word)))))


Message queue housekeeping

Message queue housekeeping

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -4,13 +4,14 @@

   Currently ALPHA QUALITY!!!

-  Prefixed keys:
-    * qname:hash:messages     ; Id -> content
-    * qname:hash:locks        ; Id -> lock-acquired time
-    * qname:list:id-circle    ; Rotating list of ids
-    * qname:set:recently-done ; Used for efficient id removal from circle
-    * qname:flag:backoff?     ; Used for queue-wide (every-worker) polling
-                              ; backoff
+  Redis keys:
+    * mqueue:<qname>:messages      -> hash, {id content}
+    * mqueue:<qname>:locks         -> hash, {id lock-acquired-time}
+    * mqueue:<qname>:id-circle     -> list, rotating list of ids
+    * mqueue:<qname>:recently-done -> set, used for efficient id removal from
+                                      circle
+    * mqueue:<qname>:backoff?      -> ttl flag, used for queue-wide (every-worker)
+                                      polling backoff

   See http://antirez.com/post/250 for implementation details."
   {:author "Peter Taoussanis"}
@@ -21,7 +22,7 @@
   (:import  [java.util UUID]))

 (def ^:private qkey "Prefixed queue key"
-  (memoize (car/make-keyfn "carmine" "queue")))
+  (memoize (car/make-keyfn "mqueue")))

 (defn enqueue
   "Pushes given message (any Clojure datatype) to named queue. Returns message
@@ -36,8 +37,8 @@
     end

     return {_:msg-id, redis.call ('lpush', _:qk-id-circle, _:msg-id)}"
-   {:qk-messages  (qkey qname "hash" "messages")
-    :qk-id-circle (qkey qname "list" "id-circle")}
+   {:qk-messages  (qkey qname "messages")
+    :qk-id-circle (qkey qname "id-circle")}
    {:msg-id       (str (UUID/randomUUID))
     :msg-content  (car/preserve message)}))

@@ -95,11 +96,11 @@
         end
       end
     end"
-   {:qk-messages       (qkey qname "hash" "messages")
-    :qk-locks          (qkey qname "hash" "locks")
-    :qk-id-circle      (qkey qname "list" "id-circle")
-    :qk-recently-done  (qkey qname "set"  "recently-done")
-    :qk-backoff        (qkey qname "flag" "backoff?")}
+   {:qk-messages       (qkey qname "messages")
+    :qk-locks          (qkey qname "locks")
+    :qk-id-circle      (qkey qname "id-circle")
+    :qk-recently-done  (qkey qname "recently-done")
+    :qk-backoff        (qkey qname "backoff?")}
    {:current-time      (str (System/currentTimeMillis))
     :handler-ttl-msecs (str handler-ttl-msecs)
     :backoff-msecs     (str backoff-msecs)
@@ -131,7 +132,7 @@

                   (try (handler-fn message-content)
                        (car/with-conn pool spec
-                         (car/sadd (qkey qname "set" "recently-done")
+                         (car/sadd (qkey qname "recently-done")
                                        message-id))
                        (catch Exception e
                          (timbre/error
@@ -186,7 +187,7 @@
   (wcar (doall (map #(enqueue "myq" (str %)) (range 10))))

   (wcar (dequeue-1 "myq"))
-  (wcar (car/lrange (qkey "myq" "list" "id-circle") 0 -1))
+  (wcar (car/lrange (qkey "myq" "id-circle") 0 -1))

   (def my-buggy-worker
     (make-dequeue-worker


Message queue: error-throwing typo

Message queue: error-throwing typo

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -257,7 +257,8 @@
                                   (car/get  (qk :ndry-runs))
                                   (car/llen (qk :mid-circle)))]

-                            (when-let [t (some #(instance? Throwable %) -resp)]
+                            (when-let [t (some #(when (instance? Throwable %) %)
+                                           -resp)]
                               (throw t))

                             (when monitor


up lang

up lang

--- src/ysmiraak/lang.clj
+++ src/ysmiraak/lang.clj
@@ -4,9 +4,9 @@

 (defrecord V [name])            (defn v? [x] (instance? V x))
 (defrecord A [vars form])       (defn a? [x] (instance? A x))
-(defrecord F [vars expr args])  (defn f? [x] (instance? F x))
+(defrecord F [vars expr pars])  (defn f? [x] (instance? F x))
 ;; vars : Set V
-;; args : Vec V
+;; pars : Vec V
 ;; form : Vec Expr

 (defprotocol Expr
@@ -26,33 +26,54 @@
   (fv [this])
   (ev [this dict]))

+(defn- fv- [pars expr & exprs]
+  (loop [exprs exprs  vars (transient (fv expr))]
+    (if-let [[expr & exprs] exprs]
+      (recur exprs (reduce conj! vars (fv expr)))
+      (persistent! (reduce disj! vars pars)))))
+
 (extend-protocol Expr
   F
   (fv [this] (:vars this))
-  (ev [{:keys [vars expr args]} dict]
-    (let [dict (reduce dissoc dict args)
-          expr (cond-> expr (some vars (keys dict)) (ev dict))]
-      (if (f? expr) ; uncurries
-        (F. (reduce disj (fv expr) args) (:expr expr) (into args (:args expr)))
-        (F. (reduce disj (fv expr) args)        expr        args))))
+  (ev [{:keys [vars expr pars]} dict]
+    (let [dict (select-keys dict vars)
+          expr (cond-> expr (seq dict) (ev dict))]
+      (cond
+        ;; F without pars evals to its expr
+        (empty? pars) expr
+        ;; uncurries immediately nested F
+        (f? expr) (F. (fv- pars expr) (:expr expr) (into pars (:pars expr)))
+        :else     (F. (fv- pars expr)        expr        pars))))
   A
   (fv [this] (:vars this))
   (ev [{:keys [vars form]} dict]
-    (let [[head & body :as form] (cond->> form (some vars (keys dict)) (mapv #(ev % dict)))]
-      (if (f? head)
-        (let [{:keys [vars expr args]} head
-              dict (zipmap args body)
-              size (count body)]
-          (case (compare (count args) size) ; beta-reduce or curry
-            0     (ev expr dict)
-            1 (F. (reduce disj vars (keys dict))
-                  (ev expr dict)
-                  (subvec args size))
-            (throw (ex-info "arity error" {:args args :vals body}))))
-        (let [vars (apply clojure.set/union (map fv form))]
-          (if (seq vars) ; defer application
+    (let [dict (select-keys dict vars)
+          [func & args :as form] (cond->> form (seq dict) (mapv #(ev % dict)))]
+      (if (f? func)
+        ;; asap beta-reduces val/var args
+        (let [{:keys [pars expr]} func
+              [args pars dict]
+              , (loop [args (seq args)  args' []
+                       pars (seq pars)  pars' []
+                       dict {}]
+                  (if-let   [[arg & args] args]
+                    (if-let [[par & pars] pars]
+                      (if (or (empty? (fv arg)) (v? arg))
+                        (recur args       args'      pars       pars'      (assoc  dict par arg))
+                        (recur args (conj args' arg) pars (conj pars' par) (dissoc dict par)))
+                      (throw (ex-info "arity error" {:form form})))
+                    [args' (into pars' pars) (reduce dissoc dict pars)]))
+              func (-> (fv- pars expr)
+                       (F.  expr pars)
+                       (ev dict))]
+          (if (seq args)
+            (A. (apply fv- [] func args) (into [func] args))
+            func))
+        ;; defers application or applies primitive func
+        (let [vars (apply fv- [] form)]
+          (if (seq vars)
             (A. vars form)
-            (apply head body))))))
+            (apply func args))))))
   V
   (fv [this] #{this})
   (ev [this dict] (dict this this))
@@ -78,23 +99,22 @@
 (defn ?
   "funcall, the counit of product-exponential adjunction"
   ([& form]
-   (-> (apply clojure.set/union (map fv form))
+   (-> (apply fv- [] form)
        (A. (vec form))
        (ev {})))
   ([]))

 (defn %
   "forall"
-  ([expr & args] ; currently args can only be vars
-   (-> (reduce disj (fv expr) args)
-       (F. expr (vec args))
+  ([expr & pars] ; currently pars can only be vars
+   (-> (fv- pars expr)
+       (F. expr (vec pars))
        (ev {})))
   ([expr] expr))

 (defn !
   "produces a fresh or named var"
   ([name] (V. name))
-  ;; todo use number instead of gensym
   ([] (! (. clojure.lang.RT (nextID)))))

 (comment


Решил поставить вариант gif изза IE и прочих браузеров

--- radiolamp-6P3S/src/r6p3s/cpt/images_gallery_1.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/images_gallery_1.cljs
@@ -47,7 +47,7 @@
          :div-id        (c/uniq-id "div") :img-id         (c/uniq-id "img")
          :div-height    nil               :img-margin-top nil
          :img-height    nil
-         :src           "/images/preloader_1_128.gif"
+         :src           "/images/loader_media.gif"
          :chan-img-load (chan)})

@@ -62,7 +62,7 @@
                   image-loader (new goog.net.ImageLoader)]
               (println "update image:" src)
               ;; Сначала ставим гифку прогресса
-              (om/set-state! own :src "/images/loader_media.svg")
+              (om/set-state! own :src "/images/loader_media.gif")
               ;; Теперь по загрузчику
               (events/listen image-loader goog.net.EventType.COMPLETE
                              (fn []


catch errors when unpacking jars in order to fix problems in windows

some of my jars contain files such as

/LICENSE
/license/LICENSE.txt

which breaks when running on a case-insensitive filesystem.

log an error in that case and go on

--- boot/pod/src/boot/pod.clj
+++ boot/pod/src/boot/pod.clj
@@ -285,7 +285,11 @@
   (doseq [[path url] (jar-entries jar)]
     (let [out   (io/file dir path)
           keep? (partial file/keep-filters? include exclude)]
-      (when (keep? (io/file path)) (copy-url url out)))))
+      (when (keep? (io/file path))
+        (try
+          (copy-url url out)
+          (catch Exception err
+            (util/warn "Error while extracting %s: %s\n" url err)))))))

 (defn jars-dep-graph
   [env]


Add test to show that Java lists can also be used as input data.

--- test/dsbdp/test/data_processing_dsl_tests.clj
+++ test/dsbdp/test/data_processing_dsl_tests.clj
@@ -125,6 +125,16 @@
     (is (= java.util.HashMap (type result)))
     (is (= expected result))))

+(deftest java-list-to-java-map-with-additional-operation-and-two-data-values-test
+  (let [expected {"quotient" 2}
+        input-data (reduce (fn [l v] (.add l v) l) (java.util.ArrayList.) [1 8 1 1 1 4 1 1])
+        dsl-expression {:output-type :java-map
+                        :rules [['quotient '(/ (nth 1) (nth 5))]]}
+        data-processing-fn (create-data-processing-fn dsl-expression)
+        result (data-processing-fn input-data 0)]
+    (is (= java.util.HashMap (type result)))
+    (is (= expected result))))
+
 (deftest clojure-map-to-java-map-with-additional-operation-and-two-data-values-test
   (let [expected {"quotient" 2}
         input-data {"x" 12, "y" 42, :z 6}


Logo: Use goog.closure.

Logo: Use goog.closure.

--- src-cljs/pepa/components/logo.cljs
+++ src-cljs/pepa/components/logo.cljs
@@ -1,6 +1,9 @@
 (ns pepa.components.logo
   (:require [om.core :as om :include-macros true]
             [sablono.core :refer-macros [html]]
+            [clojure.browser.event :as event]
+            [goog.style.transform :as transform]
+            [goog.dom :as dom]

             [pepa.navigation :as nav]))

@@ -25,26 +28,22 @@
         rect (.getBoundingClientRect obj)
         center [(/ (- (.-right rect) (.-left rect)) 2)
                 (/ (- (.-bottom rect) (.-top rect)) 2)]]
-    (set! (.-onmousemove js/window)
-          (fn [e]
-            (let [[dx dy] (vec- [e.clientX e.clientY] center)
-                  transform (str "translate("
-                                 (min (* eyeball-movement
-                                         (/ dx js/window.screen.width))
-                                      eyeball-max)
-                                 ", "
-                                 (min (* eyeball-movement
-                                         (/ dy js/window.screen.height))
-                                      eyeball-max)
-                                 ")")]
-              (.setAttribute eyeball "transform" transform))))))
+    (event/listen js/document.documentElement "mousemove"
+                  (fn [e]
+                    (let [[dx dy] (vec- [e.clientX e.clientY] center)
+                          [dw dh] (let [v (dom/getViewportSize)] [v.width v.height])
+                          tx (min (* eyeball-movement (/ dx dw))
+                                  eyeball-max)
+                          ty (min (* eyeball-movement (/ dy dh))
+                                  eyeball-max)]
+                      (transform/setTranslation eyeball tx ty))))))

 (defn xeyes [_ owner]
   (reify
     om/IDidMount
     (did-mount [_]
       (let [obj (om/get-node owner "logo")]
-        (.addEventListener obj "load" #(attach-eyeball-mover! obj))))
+        (event/listen obj "load" #(attach-eyeball-mover! obj))))
     om/IRender
     (render [_]
       (html


[#12569] RPC URL is lower-cased when entered in URL field when adding a custom network

Signed-off-by: andrey <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/network/edit_network/views.cljs
+++ src/status_im/ui/screens/network/edit_network/views.cljs
@@ -1,6 +1,5 @@
 (ns status-im.ui.screens.network.edit-network.views
-  (:require [clojure.string :as string]
-            [re-frame.core :as re-frame]
+  (:require [re-frame.core :as re-frame]
             [status-im.i18n.i18n :as i18n]
             [status-im.network.core :as network]
             [status-im.ui.screens.network.edit-network.styles :as styles]
@@ -40,7 +39,7 @@
            {:label          (i18n/label :t/rpc-url)
             :placeholder    (i18n/label :t/specify-rpc-url)
             :default-value  (get-in manage-network [:url :value])
-            :on-change-text #(re-frame/dispatch [::network/input-changed :url (string/lower-case %)])}]]]
+            :on-change-text #(re-frame/dispatch [::network/input-changed :url %])}]]]
         [quo/list-header (i18n/label :t/network-chain)]
         [list/flat-list {:data        [:mainnet :testnet :rinkeby :custom]
                          :key-fn      (fn [_ i] (str i))