404 on failed register and pwd

404 on failed register and pwd

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -149,11 +149,17 @@
         (is-authenticated? cookies (json-response (create-ex (user-from-cookie cookies) params))))

   (POST "/rest/v1/register" {params :params cookies :cookies}
-      (let [user (register-user params)]
-        (json-response {"token" (auth-token user) "username" (:username params)} 200)))
+      (let [user (register-user params)
+            username (:username user)]
+        (if (not= "nobody" username)
+          (json-response {"token" (auth-token user) "username" username} 200)
+          (json-response {"token" nil "username" username} 404))))

   (POST "/rest/v1/change-password" {params :params cookies :cookies}
-    (json-response (change-password (user-from-cookie cookies) params)))
+    (let [res (change-password (user-from-cookie cookies) params)]
+      (if (:result res)
+        (json-response res 200)
+        (json-response res 404))))

   (GET "/rest/v1/username-available/:username" [username]
        (let [user (get-user username)]


Add checkbox attr argument description

Add checkbox attr argument description

--- src/re_com/misc.cljs
+++ src/re_com/misc.cljs
@@ -197,7 +197,8 @@
    {:name :disabled?   :required false :default false :type "boolean | atom"                                  :description "if true, user interaction is disabled"}
    {:name :style       :required false                :type "CSS style map"    :validate-fn css-style?        :description "the CSS style style map"}
    {:name :label-style :required false                :type "CSS style map"    :validate-fn css-style?        :description "the CSS class applied overall to the component"}
-   {:name :label-class :required false                :type "string"           :validate-fn string?           :description "the CSS class applied to the label"}])
+   {:name :label-class :required false                :type "string"           :validate-fn string?           :description "the CSS class applied to the label"}
+   {:name :attr        :required false                :type "HTML attr map"    :validate-fn html-attr?        :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed"]}])

 ;; TODO: when disabled?, should the text appear "disabled".
 (defn checkbox


Closes issue #8

Closes issue #8

--- src/alfresco_technical_validation/binary_validation.clj
+++ src/alfresco_technical_validation/binary_validation.clj
@@ -326,6 +326,26 @@
                          START n=NODE(*)
                          MATCH (n)-->(m)
                          WHERE HAS(n.name)
+                           AND HAS(n.package)
+                           AND NOT(n.package =~ 'java.*')
+                           AND NOT(n.package =~ 'sun.*')
+                           AND NOT(n.package =~ 'com.sun.*')
+                           AND NOT(n.package =~ 'org.w3c.*')
+                           AND NOT(n.package =~ 'org.apache.*')
+                           AND NOT(n.package =~ 'org.alfresco.*')
+                           AND NOT(n.package =~ 'org.json.*')
+                           AND NOT(n.package =~ 'org.xml.*')
+                           AND NOT(n.package =~ 'org.springframework.*')
+                           AND NOT(n.package =~ 'org.hibernate.*')
+                           AND NOT(n.package =~ 'org.mybatis.*')
+                           AND NOT(n.package =~ 'net.sf.ehcache.*')
+                           AND NOT(n.package =~ 'org.quartz.*')
+                           AND NOT(n.package =~ 'org.mozilla.*')
+                           AND NOT(n.package =~ 'com.google.*')
+                           AND NOT(n.package =~ 'com.sap.*')
+                           AND NOT(n.package =~ 'com.license4j.*')
+                           AND NOT(n.package =~ 'com.aspose.*')
+                           AND NOT(n.package =~ 'asposewobfuscated.*')
                            AND HAS(m.name)
                            AND m.name IN [
                                            'org.alfresco.service.cmr.search.ResultSet',
@@ -401,10 +421,7 @@
                          MATCH (n)-->(m)
                          WHERE HAS(n.name)
                            AND HAS(m.name)
-                           AND m.name IN [
-                                           'org.alfresco.service.cmr.search.SearchService',
-                                           'org.alfresco.service.cmr.search.ResultSet'
-                                         ]
+                           AND m.name = 'org.alfresco.service.cmr.search.SearchService'
                         RETURN n.name AS ClassName, COLLECT(DISTINCT m.name) AS APIs
                          ORDER BY n.name
                        ")]


obsolete

obsolete

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -85,9 +85,6 @@
 ;;
 ;; experimental shaders
 ;;
-
-#_ (deftype TestFilter [passes shaders dirty padding uniforms fragmentSrc]
-  PIXI/AbstractFilter)

 (defn make-test []
   (let [f


Remove dissoc-in

Remove dissoc-in

--- src/tracks/core.cljc
+++ src/tracks/core.cljc
@@ -47,20 +47,6 @@
                       paths)]
        ~@body)))

-(defn dissoc-in
-  "Dissociates an entry from a nested associative structure returning a new
-  nested structure. keys is a sequence of keys. Any empty maps that result
-  will not be present in the new structure."
-  [m [k & ks :as keys]]
-  (if ks
-    (if-let [nextmap (get m k)]
-      (let [newmap (dissoc-in nextmap ks)]
-        (if (seq newmap)
-          (assoc m k newmap)
-          (dissoc m k)))
-      m)
-    (dissoc m k)))
-
 (defmacro track [in & outs]
   `(fn [in#]
      (let [~in in#]


Add missing alias for boolean-like validator on schema ns.

--- src/uxbox/schema.clj
+++ src/uxbox/schema.clj
@@ -62,5 +62,6 @@
 (def uuid-like st/uuid-like)
 (def uuid st/uuid)
 (def integer-like st/integer-like)
+(def boolean-like st/boolean-like)
 (def email st/email)
 (def validate st/validate)


new-handler can be private, and should be

--- src/yada/handler.clj
+++ src/yada/handler.clj
@@ -267,7 +267,7 @@
        req)
      match-context)))

-(s/defn new-handler [model :- ys/HandlerModel]
+(s/defn ^:private  new-handler [model :- ys/HandlerModel]
   (map->Handler model))

 (defn handler


Redirect to swagger UI with or without /

Show-boating with a set and a subs.

--- src/yada/swagger.clj
+++ src/yada/swagger.clj
@@ -135,9 +135,14 @@
            :remainder (subs (:remainder m) (count "/swagger"))}

           ;; Redirect to swagger.json
-          (= (:remainder m) "/")
-          (succeed (reify Ring (request [_ req _] (redirect (str (:uri req) "swagger/index.html?url=" (or (:basePath spec) "") "/swagger.json"))))
-                   (assoc m :remainder ""))
+          (#{"" "/"} (:remainder m))
+          (succeed
+           (reify Ring
+             (request [_ req _]
+               (redirect (str (:uri req)
+                              (subs "/swagger/index.html?url=" (count (:remainder m)))
+                              (or (:basePath spec) "") "/swagger.json"))))
+           (assoc m :remainder ""))

           ;; Otherwise
           :otherwise


Define the prod middleware

Define the prod middleware

--- env/prod/clj/hyphen_keeper/middleware.clj
+++ env/prod/clj/hyphen_keeper/middleware.clj
@@ -1,5 +1,13 @@
 (ns hyphen-keeper.middleware
-  (:require [ring.middleware.defaults :refer [site-defaults wrap-defaults]]))
+  (:require [ring.middleware
+             [defaults :refer [api-defaults site-defaults wrap-defaults]]
+             [json :refer [wrap-json-params wrap-json-response]]]))

-(defn wrap-middleware [handler]
+(defn wrap-api-middleware [handler]
+  (-> handler
+      (wrap-defaults api-defaults)
+      wrap-json-params
+      wrap-json-response))
+
+(defn wrap-site-middleware [handler]
   (wrap-defaults handler site-defaults))


faster rendering of svg elements

faster rendering of svg elements

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -108,7 +108,7 @@
                                                   (cast! :layer-selected {:db/id (:db/id layer)}))
                                                :onMouseUp #(.stopPropagation %)
                                                :className "selectable")))))
-                     layers))))))
+                     (remove #(= :layer.type/group (:layer/type %)) layers)))))))

 (defn subscriber-cursor-icon [tool]
   (case (name tool)


New footer layout

New footer layout

--- src-cljs/frontend/components/footer.cljs
+++ src-cljs/frontend/components/footer.cljs
@@ -3,35 +3,54 @@

 (defn footer []
-  [:nav.footer-nav.container-fluid
-   [:div.row
-    [:div.col-sm-4.col-sm-push-1
-     [:ul.list-unstyled
-      [:li.header "CircleCI"]
-      [:li [:a {:href "/about"} "About Us"]]
-      [:li [:a {:href "/about/team"} "Team"]]
-      [:li [:a {:href "/press"} "Press"]]
-      (when-not (config/enterprise?)
-        [:li [:a {:href "/jobs"} "Jobs"]])
-      [:li [:a {:href "http://blog.circleci.com"} "Blog"]]]]
-    [:div.col-sm-3
-     [:ul.list-unstyled
-      [:li.header "Product"]
-      [:li [:a {:href "/features"} "Features"]]
-      [:li [:a {:href "/mobile"} "Mobile"]]
-      [:li [:a {:href "/enterprise"} "Enterprise"]]
-      (when-not (config/enterprise?)
-        [:li [:a {:href "/pricing"} "Pricing"]])
-      [:li [:a {:href "/changelog"} "Changelog"]]]]
-    [:div.col-sm-3
-     [:ul.list-unstyled
-      [:li.header "Help"]
-      [:li [:a {:href "/docs"} "Documentation"]]
-      [:li [:a {:href "/security"} "Security"]]
-      [:li [:a {:href "/privacy"} "Privacy"]]
-      [:li [:a {:href "/contact"} "Contact Us"]]]]
-    [:div.col-sm-1
-     [:a.fa.fa-twitter
-      {:title "Follow CircleCI on Twitter",
-       :href "https://twitter.com/circleci"
-       :target "_blank"}]]]])
+  [:footer.footer
+    [:div.container
+      [:div.row
+        [:div.col-md-5
+          [:p.lead "Over "
+            [:b "200,000"] " projects and 126k users are testing on CircleCI."]
+          [:span "Free Hosted Continuous Integration and Deployment for web and mobile applications. Automated build, test & deployment for public & private projects. Build better apps and ship code faster with CircleCI."]
+          [:div.social-btns
+            [:a.social-btn-rss {:href "http://blog.circleci.com/", :data-text , :data-url}
+             [:div
+              [:i.fa.fa-rss]]]
+            [:a.social-btn-facebook {:href "https://www.facebook.com/circletest", :data-text , :data-url}
+             [:div
+              [:i.fa.fa-facebook-official]]]
+            [:a.social-btn-twitter {:href "https://twitter.com/circleci", :data-text , :data-url}
+             [:div
+              [:i.fa.fa-twitter]]]
+            [:a.social-btn-github {:href "https://github.com/circleci", :data-text , :data-url}
+             [:div
+              [:i.fa.fa-github]]]
+            [:a.social-btn-linkedin {:href "https://www.linkedin.com/company/circleci", :data-text , :data-url}
+             [:div
+              [:i.fa.fa-linkedin]]]]]
+        [:nav
+          [:div.col-md-2.col-md-offset-1
+            [:h6 "CircleCI"]
+            [:ul.list-unstyled
+              [:li [:a {:href "/about"} "About Us"]]
+              [:li [:a {:href "/about/team"} "Team"]]
+              [:li [:a {:href "/press"} "Press"]]
+              [:li [:a {:href "/jobs"} "Jobs"]]
+              [:li [:a {:href "http://blog.circleci.com"} "Blog"]]]]
+          [:div.col-md-2
+            [:h6 "Product"]
+            [:ul.list-unstyled
+              [:li [:a {:href "/features"} "Features"]]
+              [:li [:a {:href "/mobile"} "Mobile"]]
+              [:li [:a {:href "/enterprise"} "Enterprise"]]
+              [:li [:a {:href "/pricing"} "Pricing"]]
+              [:li [:a {:href "/changelog"} "Changelog"]]]]
+          [:div.col-md-2
+            [:h6 "Contact"]
+            [:ul.list-unstyled
+              [:li [:a {:href "/docs"} "Documentation"]]
+              [:li [:a {:href "https://discuss.circleci.com/"} "Discuss"]]
+              [:li [:a {:href "/security"} "Security"]]
+              [:li [:a {:href "/privacy"} "Privacy"]]
+              [:li [:a {:href "/contact"} "Contact Us"]]]]]]
+      [:div.row
+        [:div.col-md-5.additional-links
+          [:span "Copyright © 2015 CircleCI"]]]]])


Contact us

Contact us

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -196,7 +196,7 @@
                [:li (maybe-active nav-point :about)
                 [:a {:href "/about"} "Overview"]]
                [:li (maybe-active nav-point :contact)
-                [:a {:href "/contact"} "Contact"]]]]])])))))
+                [:a {:href "/contact"} "Contact Us"]]]]])])))))

 (defn inner-header [app owner]
   (reify


Add more details to generated data.

Add more details to generated data.

--- dev/kixi/hecuba/dev/generators.clj
+++ dev/kixi/hecuba/dev/generators.clj
@@ -17,31 +17,46 @@
 ;;;;;;;;;;;;;; Generate sensors ;;;;;;;;;;;;;;;

 (defn type-gen []
-  (gen/elements ["relativeHumidity" "temperature" "electricityConsumption" "gasAsHeatingFuel"]))
+  (gen/elements ["relativeHumidity" "temperature" "electricityConsumption" "gasAsHeatingFuel"
+                 "solarRadiation" "waterConsumption" "temperatureGround" "co2"]))
+
+(defn unit-gen [type]
+  (cond
+   (= "relativeHumidity" type) "%RH"
+   (= "temperature" type) "C"
+   (= "electricityConsumption" type) "kWh"
+   (= "gasHeatingFuel" type) "m^3"
+   (= "solarRadiation" type) "W/m^2"
+   (= "waterConsumption" type) "L"
+   (= "temperatureGround" type) "C"
+   (= "co2" type) "ppm"
+   :else ""))

 (defn generate-sensor-sample [period n]
-  (take n (repeatedly n #(hash-map
-                          :type (first (gen/sample (type-gen) 1))
-                          :unit ""
-                          :resolution ""
-                          :accuracy ""
-                          :period (first (gen/sample (gen/elements [period])))
-                          :min ""
-                          :max ""
-                          :correction ""
-                          :correctedUnit ""
-                          :correctionFactor ""
-                          :correctionFactorBreakdown ""
-                          :events 0
-                          :errors 0))))
+  (take n (repeatedly n #(let [type (first (gen/sample (type-gen) 1))
+                               unit (unit-gen type)]
+                           {:type type
+                            :unit unit
+                            :resolution (str (rand-int 60))
+                            :accuracy (str (rand-int 100))
+                            :period (first (gen/sample (gen/elements [period])))
+                            :min "0"
+                            :max (str (rand-int 100))
+                            :correction ""
+                            :correctedUnit ""
+                            :correctionFactor ""
+                            :correctionFactorBreakdown ""
+                            :events 0
+                            :errors 0}))))

 ;;;;;;;;;;;;;;; Generate devices ;;;;;;;;;;;;;;

 (def location-gen
-  (gen/hash-map :name gen/string-alpha-numeric
-                :latitude gen/string-alpha-numeric
-                :longitude gen/string-alpha-numeric))
+  {:name (first (gen/sample
+                 (gen/not-empty (gen/elements ["Kitchen" "Living Room Floor" "Living Room Ceiling" "Bathroom"])) 1))
+   :latitude (str (rand 55))
+   :longitude (str (rand 1))})

 (defn generate-device-sample
   [entity-id n]
@@ -50,7 +65,7 @@
                                  :description (first (gen/sample gen/string 1))
                                  :parent-id (uuid)
                                  :entity-id entity-id
-                                 :location (json/write-str (first (gen/sample location-gen 1)))
+                                 :location (json/write-str location-gen)
                                  :metadata ""
                                  :privacy (first (gen/sample (gen/not-empty (gen/elements ["public" "private"])) 1))
                                  :meteringPointId (uuid)))))


improving conjugation by adding :g to pattern rules

--- src/babel/italiano/morphology/verbs.cljc
+++ src/babel/italiano/morphology/verbs.cljc
@@ -128,7 +128,14 @@
          #"(.*)rrò"     "$1nire" ;; verrò -> venire
          #"(.*)gherò"   "$1gare" ;; piegherò -> piegare
          #"(.*)rrò"     "$1nere" ;; rimarrò -> rimanere
-         ]}
+         ]
+
+     :g [
+         #"^(.*)are$"   "$1ò"
+         #"^(.*)ere$"   "$1ò"
+         #"^(.*)ire$"   "$1ò"
+         ]
+     }

     {:agr {:synsem {:subcat {:1 {:agr {:number :sing
                                        :person :2nd}}}}}
@@ -1109,9 +1116,16 @@
        (get-in word '(:future-stem))))

 (defn handle2 [word]
+  (log/error (str "handle2: " (dag_unify.core/strip-refs word)))
   (let [stem (get-in word '(:future-stem))
         number (get-in word [:agr :number])
-        person (get-in word [:agr :person])]
+        person (get-in word [:agr :person])
+        patterns replace-patterns-future-tense]
+    (-> patterns
+        (map (fn [pattern]
+               (let [[from to] (nth (:g pattern))]
+                 from)))
+        (remove nil?))
     (cond
       (and (= person :1st) (= number :sing))
       (str stem "ò")
@@ -1242,6 +1256,8 @@
    (= :1st (get-in word '(:agr :person)))
    (string? (get-in word '(:imperfect :1sing)))))

+;; irregular imperfect sense:
+;; 1) use irregular based on number and person.
 (defn handle6 [word]
   (get-in word [:imperfect :1sing]))


refactoring: submitTopology calls submitTopologyWithOpts

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -866,227 +866,223 @@
                         (conf NIMBUS-CLEANUP-INBOX-FREQ-SECS)
                         (fn []
                           (clean-inbox (inbox nimbus) (conf NIMBUS-INBOX-JAR-EXPIRATION-SECS))
-                          ))
-    (letfn [(submit-topology-with-opts
-              [storm-name ^String uploadedJarLocation ^String serializedConf ^StormTopology topology & {:keys [topology-initial-status]}]
-              (validate-topology-name! storm-name)
-              (check-storm-active! nimbus storm-name false)
-              (swap! (:submitted-count nimbus) inc)
-              (let [storm-id (str storm-name "-" @(:submitted-count nimbus) "-" (current-time-secs))
-                    storm-conf (normalize-conf
-                                conf
-                                (-> serializedConf
-                                    from-json
-                                    (assoc STORM-ID storm-id)
-                                    (assoc TOPOLOGY-NAME storm-name))
-                                topology)
-                    total-storm-conf (merge conf storm-conf)
-                    topology (normalize-topology total-storm-conf topology)
-                    topology (if (total-storm-conf TOPOLOGY-OPTIMIZE)
-                               (optimize-topology topology)
-                               topology)
-                    storm-cluster-state (:storm-cluster-state nimbus)]
-                (system-topology! total-storm-conf topology) ;; this validates the structure of the topology
-                (log-message "Received topology submission for " storm-name " with conf " storm-conf)
-                ;; lock protects against multiple topologies being submitted at once and
-                ;; cleanup thread killing topology in b/w assignment and starting the topology
-                (locking (:submit-lock nimbus)
-                  (setup-storm-code conf storm-id uploadedJarLocation storm-conf topology)
-                  (.setup-heartbeats! storm-cluster-state storm-id)
-                  (start-storm nimbus storm-name storm-id topology-initial-status)
-                  (mk-assignments nimbus))))]
-      (reify Nimbus$Iface
-        (^void submitTopologyWithOpts
-          [this ^String storm-name ^String uploadedJarLocation ^String serializedConf ^StormTopology topology ^SubmitOptions submitOptions]
-          (assert (not-nil? submitOptions))
-          (let [thrift-status->kw-status {TopologyInitialStatus/INACTIVE :inactive
-                                          TopologyInitialStatus/ACTIVE :active}]
-            (submit-topology-with-opts storm-name uploadedJarLocation serializedConf topology
-              :topology-initial-status (thrift-status->kw-status (.get_initial_status submitOptions)))))
-
-        (^void submitTopology
-          [this ^String storm-name ^String uploadedJarLocation ^String serializedConf ^StormTopology topology]
-          (submit-topology-with-opts storm-name uploadedJarLocation serializedConf topology
-            :topology-initial-status :active))
-
-        (^void killTopology [this ^String name]
-          (.killTopologyWithOpts this name (KillOptions.)))
-
-        (^void killTopologyWithOpts [this ^String storm-name ^KillOptions options]
-          (check-storm-active! nimbus storm-name true)
-          (let [wait-amt (if (.is_set_wait_secs options)
-                           (.get_wait_secs options)
-                           )]
-            (transition-name! nimbus storm-name [:kill wait-amt] true)
-            ))
-
-        (^void rebalance [this ^String storm-name ^RebalanceOptions options]
-          (check-storm-active! nimbus storm-name true)
-          (let [wait-amt (if (.is_set_wait_secs options)
-                           (.get_wait_secs options))
-                num-workers (if (.is_set_num_workers options)
-                              (.get_num_workers options))
-                executor-overrides (if (.is_set_num_executors options)
-                                     (.get_num_executors options)
-                                     {})]
-            (doseq [[c num-executors] executor-overrides]
-              (when (<= num-executors 0)
-                (throw (InvalidTopologyException. "Number of executors must be greater than 0"))
-                ))
-            (transition-name! nimbus storm-name [:rebalance wait-amt num-workers executor-overrides] true)
-            ))
-
-        (activate [this storm-name]
-          (transition-name! nimbus storm-name :activate true)
-          )
-
-        (deactivate [this storm-name]
-          (transition-name! nimbus storm-name :inactivate true))
-
-        (beginFileUpload [this]
-          (let [fileloc (str (inbox nimbus) "/stormjar-" (uuid) ".jar")]
-            (.put (:uploaders nimbus)
-                  fileloc
-                  (Channels/newChannel (FileOutputStream. fileloc)))
-            (log-message "Uploading file from client to " fileloc)
-            fileloc
-            ))
-
-        (^void uploadChunk [this ^String location ^ByteBuffer chunk]
-          (let [uploaders (:uploaders nimbus)
-                ^WritableByteChannel channel (.get uploaders location)]
-            (when-not channel
-              (throw (RuntimeException.
-                      "File for that location does not exist (or timed out)")))
-            (.write channel chunk)
-            (.put uploaders location channel)
-            ))
-
-        (^void finishFileUpload [this ^String location]
-          (let [uploaders (:uploaders nimbus)
-                ^WritableByteChannel channel (.get uploaders location)]
-            (when-not channel
-              (throw (RuntimeException.
-                      "File for that location does not exist (or timed out)")))
-            (.close channel)
-            (log-message "Finished uploading file from client: " location)
-            (.remove uploaders location)
-            ))
-
-        (^String beginFileDownload [this ^String file]
-          (let [is (BufferFileInputStream. file)
-                id (uuid)]
-            (.put (:downloaders nimbus) id is)
-            id
-            ))
-
-        (^ByteBuffer downloadChunk [this ^String id]
-          (let [downloaders (:downloaders nimbus)
-                ^BufferFileInputStream is (.get downloaders id)]
-            (when-not is
-              (throw (RuntimeException.
-                      "Could not find input stream for that id")))
-            (let [ret (.read is)]
-              (.put downloaders id is)
-              (when (empty? ret)
-                (.remove downloaders id))
-              (ByteBuffer/wrap ret)
-              )))
-
-        (^String getTopologyConf [this ^String id]
-          (to-json (read-storm-conf conf id)))
-
-        (^StormTopology getTopology [this ^String id]
-          (system-topology! (read-storm-conf conf id) (read-storm-topology conf id)))
-
-        (^StormTopology getUserTopology [this ^String id]
-          (read-storm-topology conf id))
-
-        (^ClusterSummary getClusterInfo [this]
-          (let [storm-cluster-state (:storm-cluster-state nimbus)
-                assigned (assigned-slots storm-cluster-state)
-                supervisor-infos (all-supervisor-info storm-cluster-state)
-                ;; TODO: need to get the port info about supervisors...
-                ;; in standalone just look at metadata, otherwise just say N/A?
-                supervisor-summaries (dofor [[id info] supervisor-infos]
-                                            (let [ports (set (:meta info))
-                                                  ]
-                                              (SupervisorSummary. (:hostname info)
-                                                                  (:uptime-secs info)
-                                                                  (count ports)
-                                                                  (count (assigned id)))
-                                              ))
-                nimbus-uptime ((:uptime nimbus))
-                bases (topology-bases storm-cluster-state)
-                topology-summaries (dofor [[id base] bases]
-                                          (let [assignment (.assignment-info storm-cluster-state id nil)]
-                                            (TopologySummary. id
-                                                              (:storm-name base)
-                                                              (->> (:executor->node+port assignment)
-                                                                   keys
-                                                                   (mapcat executor-id->tasks)
-                                                                   count)
-                                                              (->> (:executor->node+port assignment)
-                                                                   keys
-                                                                   count)
-                                                              (->> (:executor->node+port assignment)
-                                                                   vals
-                                                                   set
-                                                                   count)
-                                                              (time-delta (:launch-time-secs base))
-                                                              (extract-status-str base))
-                                            ))]
-            (ClusterSummary. supervisor-summaries
-                             nimbus-uptime
-                             topology-summaries)
-            ))
-
-        (^TopologyInfo getTopologyInfo [this ^String storm-id]
-          (let [storm-cluster-state (:storm-cluster-state nimbus)
-                task->component (storm-task-info (read-storm-topology conf storm-id) (read-storm-conf conf storm-id))
-                base (.storm-base storm-cluster-state storm-id nil)
-                assignment (.assignment-info storm-cluster-state storm-id nil)
-                beats (.executor-beats storm-cluster-state storm-id (:executor->node+port assignment))
-                all-components (-> task->component reverse-map keys)
-                errors (->> all-components
-                            (map (fn [c] [c (get-errors storm-cluster-state storm-id c)]))
-                            (into {}))
-                executor-summaries (dofor [[executor [node port]] (:executor->node+port assignment)]
-                                          (let [host (-> assignment :node->host (get node))
-                                                heartbeat (get beats executor)
-                                                stats (:stats heartbeat)
-                                                stats (if stats
-                                                        (stats/thriftify-executor-stats stats))]
-                                            (doto
-                                                (ExecutorSummary. (thriftify-executor-id executor)
-                                                                  (-> executor first task->component)
-                                                                  host
-                                                                  port
-                                                                  (nil-to-zero (:uptime heartbeat)))
-                                              (.set_stats stats))
+                          ))
+    (reify Nimbus$Iface
+      (^void submitTopologyWithOpts
+        [this ^String storm-name ^String uploadedJarLocation ^String serializedConf ^StormTopology topology ^SubmitOptions submitOptions]
+        (assert (not-nil? submitOptions))
+        (validate-topology-name! storm-name)
+        (check-storm-active! nimbus storm-name false)
+        (swap! (:submitted-count nimbus) inc)
+        (let [storm-id (str storm-name "-" @(:submitted-count nimbus) "-" (current-time-secs))
+              storm-conf (normalize-conf
+                          conf
+                          (-> serializedConf
+                              from-json
+                              (assoc STORM-ID storm-id)
+                              (assoc TOPOLOGY-NAME storm-name))
+                          topology)
+              total-storm-conf (merge conf storm-conf)
+              topology (normalize-topology total-storm-conf topology)
+              topology (if (total-storm-conf TOPOLOGY-OPTIMIZE)
+                         (optimize-topology topology)
+                         topology)
+              storm-cluster-state (:storm-cluster-state nimbus)]
+          (system-topology! total-storm-conf topology) ;; this validates the structure of the topology
+          (log-message "Received topology submission for " storm-name " with conf " storm-conf)
+          ;; lock protects against multiple topologies being submitted at once and
+          ;; cleanup thread killing topology in b/w assignment and starting the topology
+          (locking (:submit-lock nimbus)
+            (setup-storm-code conf storm-id uploadedJarLocation storm-conf topology)
+            (.setup-heartbeats! storm-cluster-state storm-id)
+            (let [thrift-status->kw-status {TopologyInitialStatus/INACTIVE :inactive
+                                            TopologyInitialStatus/ACTIVE :active}]
+              (start-storm nimbus storm-name storm-id (thrift-status->kw-status (.get_initial_status submitOptions))))
+            (mk-assignments nimbus))))
+
+      (^void submitTopology
+        [this ^String storm-name ^String uploadedJarLocation ^String serializedConf ^StormTopology topology]
+        (.submitTopologyWithOpts this storm-name uploadedJarLocation serializedConf topology
+                                 (SubmitOptions. TopologyInitialStatus/ACTIVE)))
+
+      (^void killTopology [this ^String name]
+        (.killTopologyWithOpts this name (KillOptions.)))
+
+      (^void killTopologyWithOpts [this ^String storm-name ^KillOptions options]
+        (check-storm-active! nimbus storm-name true)
+        (let [wait-amt (if (.is_set_wait_secs options)
+                         (.get_wait_secs options)
+                         )]
+          (transition-name! nimbus storm-name [:kill wait-amt] true)
+          ))
+
+      (^void rebalance [this ^String storm-name ^RebalanceOptions options]
+        (check-storm-active! nimbus storm-name true)
+        (let [wait-amt (if (.is_set_wait_secs options)
+                         (.get_wait_secs options))
+              num-workers (if (.is_set_num_workers options)
+                            (.get_num_workers options))
+              executor-overrides (if (.is_set_num_executors options)
+                                   (.get_num_executors options)
+                                   {})]
+          (doseq [[c num-executors] executor-overrides]
+            (when (<= num-executors 0)
+              (throw (InvalidTopologyException. "Number of executors must be greater than 0"))
+              ))
+          (transition-name! nimbus storm-name [:rebalance wait-amt num-workers executor-overrides] true)
+          ))
+
+      (activate [this storm-name]
+        (transition-name! nimbus storm-name :activate true)
+        )
+
+      (deactivate [this storm-name]
+        (transition-name! nimbus storm-name :inactivate true))
+
+      (beginFileUpload [this]
+        (let [fileloc (str (inbox nimbus) "/stormjar-" (uuid) ".jar")]
+          (.put (:uploaders nimbus)
+                fileloc
+                (Channels/newChannel (FileOutputStream. fileloc)))
+          (log-message "Uploading file from client to " fileloc)
+          fileloc
+          ))
+
+      (^void uploadChunk [this ^String location ^ByteBuffer chunk]
+        (let [uploaders (:uploaders nimbus)
+              ^WritableByteChannel channel (.get uploaders location)]
+          (when-not channel
+            (throw (RuntimeException.
+                    "File for that location does not exist (or timed out)")))
+          (.write channel chunk)
+          (.put uploaders location channel)
+          ))
+
+      (^void finishFileUpload [this ^String location]
+        (let [uploaders (:uploaders nimbus)
+              ^WritableByteChannel channel (.get uploaders location)]
+          (when-not channel
+            (throw (RuntimeException.
+                    "File for that location does not exist (or timed out)")))
+          (.close channel)
+          (log-message "Finished uploading file from client: " location)
+          (.remove uploaders location)
+          ))
+
+      (^String beginFileDownload [this ^String file]
+        (let [is (BufferFileInputStream. file)
+              id (uuid)]
+          (.put (:downloaders nimbus) id is)
+          id
+          ))
+
+      (^ByteBuffer downloadChunk [this ^String id]
+        (let [downloaders (:downloaders nimbus)
+              ^BufferFileInputStream is (.get downloaders id)]
+          (when-not is
+            (throw (RuntimeException.
+                    "Could not find input stream for that id")))
+          (let [ret (.read is)]
+            (.put downloaders id is)
+            (when (empty? ret)
+              (.remove downloaders id))
+            (ByteBuffer/wrap ret)
+            )))
+
+      (^String getTopologyConf [this ^String id]
+        (to-json (read-storm-conf conf id)))
+
+      (^StormTopology getTopology [this ^String id]
+        (system-topology! (read-storm-conf conf id) (read-storm-topology conf id)))
+
+      (^StormTopology getUserTopology [this ^String id]
+        (read-storm-topology conf id))
+
+      (^ClusterSummary getClusterInfo [this]
+        (let [storm-cluster-state (:storm-cluster-state nimbus)
+              assigned (assigned-slots storm-cluster-state)
+              supervisor-infos (all-supervisor-info storm-cluster-state)
+              ;; TODO: need to get the port info about supervisors...
+              ;; in standalone just look at metadata, otherwise just say N/A?
+              supervisor-summaries (dofor [[id info] supervisor-infos]
+                                          (let [ports (set (:meta info))
+                                                ]
+                                            (SupervisorSummary. (:hostname info)
+                                                                (:uptime-secs info)
+                                                                (count ports)
+                                                                (count (assigned id)))
                                             ))
-                ]
-            (TopologyInfo. storm-id
-                           (:storm-name base)
-                           (time-delta (:launch-time-secs base))
-                           executor-summaries
-                           (extract-status-str base)
-                           errors
-                           )
-            ))
-
-        Shutdownable
-        (shutdown [this]
-          (log-message "Shutting down master")
-          (cancel-timer (:timer nimbus))
-          (.disconnect (:storm-cluster-state nimbus))
-          (.cleanup (:downloaders nimbus))
-          (.cleanup (:uploaders nimbus))
-          (log-message "Shut down master")
-          )
-        DaemonCommon
-        (waiting? [this]
-          (timer-waiting? (:timer nimbus)))))))
+              nimbus-uptime ((:uptime nimbus))
+              bases (topology-bases storm-cluster-state)
+              topology-summaries (dofor [[id base] bases]
+                                        (let [assignment (.assignment-info storm-cluster-state id nil)]
+                                          (TopologySummary. id
+                                                            (:storm-name base)
+                                                            (->> (:executor->node+port assignment)
+                                                                 keys
+                                                                 (mapcat executor-id->tasks)
+                                                                 count)
+                                                            (->> (:executor->node+port assignment)
+                                                                 keys
+                                                                 count)
+                                                            (->> (:executor->node+port assignment)
+                                                                 vals
+                                                                 set
+                                                                 count)
+                                                            (time-delta (:launch-time-secs base))
+                                                            (extract-status-str base))
+                                          ))]
+          (ClusterSummary. supervisor-summaries
+                           nimbus-uptime
+                           topology-summaries)
+          ))
+
+      (^TopologyInfo getTopologyInfo [this ^String storm-id]
+        (let [storm-cluster-state (:storm-cluster-state nimbus)
+              task->component (storm-task-info (read-storm-topology conf storm-id) (read-storm-conf conf storm-id))
+              base (.storm-base storm-cluster-state storm-id nil)
+              assignment (.assignment-info storm-cluster-state storm-id nil)
+              beats (.executor-beats storm-cluster-state storm-id (:executor->node+port assignment))
+              all-components (-> task->component reverse-map keys)
+              errors (->> all-components
+                          (map (fn [c] [c (get-errors storm-cluster-state storm-id c)]))
+                          (into {}))
+              executor-summaries (dofor [[executor [node port]] (:executor->node+port assignment)]
+                                        (let [host (-> assignment :node->host (get node))
+                                              heartbeat (get beats executor)
+                                              stats (:stats heartbeat)
+                                              stats (if stats
+                                                      (stats/thriftify-executor-stats stats))]
+                                          (doto
+                                              (ExecutorSummary. (thriftify-executor-id executor)
+                                                                (-> executor first task->component)
+                                                                host
+                                                                port
+                                                                (nil-to-zero (:uptime heartbeat)))
+                                            (.set_stats stats))
+                                          ))
+              ]
+          (TopologyInfo. storm-id
+                         (:storm-name base)
+                         (time-delta (:launch-time-secs base))
+                         executor-summaries
+                         (extract-status-str base)
+                         errors
+                         )
+          ))
+
+      Shutdownable
+      (shutdown [this]
+        (log-message "Shutting down master")
+        (cancel-timer (:timer nimbus))
+        (.disconnect (:storm-cluster-state nimbus))
+        (.cleanup (:downloaders nimbus))
+        (.cleanup (:uploaders nimbus))
+        (log-message "Shut down master")
+        )
+      DaemonCommon
+      (waiting? [this]
+        (timer-waiting? (:timer nimbus))))))

 (defn launch-server! [conf nimbus]
   (validate-distributed-mode! conf)


Code for the drug model

Code for the drug model

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

--- src/conexp/contrib/dl/util/read_wiki.clj
+++ src/conexp/contrib/dl/util/read_wiki.clj
@@ -36,25 +36,29 @@
   [hash-map]
   (reduce + (map #(count (get hash-map %)) (keys hash-map))))

-(defn- read-lines-from-file [file interesting-role? interesting-A? interesting-B?]
-  (with-in-reader file
-    (binding [*in* (clojure.lang.LineNumberingPushbackReader. *in*)]
-      (loop [map {},
-             line-count 0]
-        (if-let [line (read-line)]
-          (do
-            (when (zero? (mod line-count 10000))
-              (println line-count (map-count map)))
-            (let [[role [A B]] (line-to-pair line)]
-              (recur (if (and (interesting-role? role)
-                              (interesting-A? A)
-                              (interesting-B? B))
-                       (update-in map [role] conj [A B])
-                       map)
-                     (inc line-count))))
-          (do
-            (println line-count)
-            map))))))
+(defn- read-lines-from-file
+  ([file]
+     (read-lines-from-file file (constantly true) (constantly true) (constantly true)))
+  ([file interesting-role? interesting-A? interesting-B?]
+     (with-in-reader file
+       (binding [*in* (clojure.lang.LineNumberingPushbackReader. *in*)]
+         (loop [map        {},
+                line-count 0]
+           (if-let [line (read-line)]
+             (do
+               (when (zero? (mod line-count 10000))
+                 (println line-count (map-count map)))
+               (let [[role [A B]] (line-to-pair line)]
+                 (recur (if (and role A B
+                                 (interesting-role? role)
+                                 (interesting-A? A)
+                                 (interesting-B? B))
+                          (update-in map [role] conj [A B])
+                          map)
+                        (inc line-count))))
+             (do
+               (println line-count)
+               map)))))))

 (defn- capitalize
   "Capitalizes word."
@@ -78,10 +82,7 @@
    coll))

 (defn- prepare-for-conexp [hash-map]
-  (reduce! (fn [map [k v]]
-             (assoc! map k (set v)))
-           {}
-           (symbolify hash-map)))
+  (symbolify hash-map))

 (defn- role-map->concept-map [role-map]
   (assert (= 1 (count role-map)))
@@ -258,6 +259,64 @@

   )

+;;; Drug Model
+
+(defn- role-to-concept
+  ([map role triples]
+     (role-to-concept map role triples (fn [x y] (str x "-" y))))
+  ([map role triples modifier]
+     (reduce (fn [map [A B]]
+               (assoc map B (conj (get map B) (modifier role A))))
+             map
+             (get triples role))))
+
+(defn read-drug-model [file]
+  (let [triples  (read-lines-from-file file),
+        roles    (reduce (fn [map [r pairs]]
+                           (if (re-find #"(drugbank/(target|enzyme|possibleDiseaseTarget|interactionDrug)|diseasome/diseaseSubtypeOf)" r)
+                             (assoc map r pairs)
+                             map))
+                         {}
+                         triples),
+        roles    (let [interactions (merge-with vector
+                                                (into {} (get roles "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/interactionDrug1"))
+                                                (into {} (get roles "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/interactionDrug2")))]
+                   (assoc (dissoc roles
+                                  "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/interactionDrug1"
+                                  "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/interactionDrug2")
+                     "interacts-with" (vals interactions))),
+        roles    (rename-keys roles
+                              {"http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/possibleDiseaseTarget" "Possible-disease-target",
+                               "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/enzyme"                "Has-enzyme",
+                               "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/target"                "Has-target",
+                               "http://www4.wiwiss.fu-berlin.de/diseasome/resource/diseasome/diseaseSubtypeOf"    "Disease-subtype-of"}),
+
+        concepts (-> {}
+                     (role-to-concept "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
+                                      triples
+                                      (fn [x y] y))
+                     (role-to-concept "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/drugCategory"
+                                      triples
+                                      (fn [x y] y))
+                     (role-to-concept "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/drugType"
+                                      triples
+                                      (fn [x y] y))
+                     (role-to-concept "http://www4.wiwiss.fu-berlin.de/drugbank/resource/drugbank/dosageForm"
+                                      triples
+                                      (fn [x y] y))
+                     (role-to-concept "http://www4.wiwiss.fu-berlin.de/diseasome/resource/diseasome/associatedGene"
+                                      triples
+                                      (fn [x y] y))
+                     (role-to-concept "http://www4.wiwiss.fu-berlin.de/diseasome/resource/diseasome/class"
+                                      triples
+                                      (fn [x y] y))),
+
+        roles    (prepare-for-conexp roles),
+        concepts (prepare-for-conexp concepts)]
+    (hash-map->interpretation concepts
+                              roles
+                              :base-lang EL-gfp)))
+
 ;;;

 nil


Flushing stdout prior to exiting

Flushing stdout prior to exiting

--- jvm-runner/src/clojure/codewars/core.clj
+++ jvm-runner/src/clojure/codewars/core.clj
@@ -7,6 +7,10 @@
             [codewars.runner.clojure])
   (:import [java.util.concurrent TimeoutException])
   (:gen-class))
+
+(defn- flush-out [val]
+  (flush)
+  val)

 (defn- fail [e]
   (binding [*out* *err*]
@@ -19,5 +23,5 @@
   (let [ms (-> env :timeout Integer/parseInt)
         input (json/parse-stream *in* true)]
     (try
-      (with-timeout ms (run input))
+      (flush-out (with-timeout ms (run input)))
       (catch Exception e (fail e)))))


Provide with speed

Provide with speed

--- higher/desktop/src-common/higher/core.clj
+++ higher/desktop/src-common/higher/core.clj
@@ -6,7 +6,7 @@
   :on-show
   (fn [screen entities]
     (update! screen :renderer (stage))
-    (assoc (texture "Clojure_logo.gif") :x 50 :y 100))
+    (assoc (texture "Clojure_logo.gif") :x 50 :y 100 :vx 0 :vy 0))

   :on-render
   (fn [screen entities]


fix not catching enough exceptions

fix not catching enough exceptions

--- src/main/shadow/cljs/devtools/server.clj
+++ src/main/shadow/cljs/devtools/server.clj
@@ -38,8 +38,9 @@
   (:import (java.net BindException URI)
            [java.lang.management ManagementFactory]
            [java.util UUID]
-           [java.net.http HttpRequest HttpClient HttpClient$Version HttpConnectTimeoutException HttpResponse$BodyHandlers]
-           [java.time Duration]))
+           [java.net.http HttpRequest HttpClient HttpClient$Version HttpResponse$BodyHandlers]
+           [java.time Duration]
+           [java.io IOException]))

 (defn wait-for [app-ref]
   (or @app-ref
@@ -416,7 +417,7 @@
                            ". Use or terminate it before starting another one.")
                       other))))))

-          (catch HttpConnectTimeoutException e
+          (catch IOException e
             ;; fine, no other server running
             ))))))


fix naming scheme

fix naming scheme

--- frontend/components/pricing-b.cljs
+++ frontend/components/pricing-b.cljs
@@ -25,9 +25,9 @@
                    [dommy.macros :refer [sel1 node]])
   (:import [goog.ui IdGenerator]))

-(def pricing-containers-max 64)
+(def max-containers 64)

-(def pricing-increment (/ 100.0 pricing-containers-max))
+(def increment (/ 100.0 max-containers))

 (defn calculate-drag-percent [owner event]
   (let [slider (om/get-node owner "pricing-range")
@@ -36,14 +36,14 @@
         event-left (.-pageX event)
         ; increment (/ 100.0 64)
         ]
-    (* pricing-increment (.ceil js/Math (/ (min 100 (max 0 (* 100 (/ (- event-left slider-left) width)))) pricing-increment)))))
+    (* increment (.ceil js/Math (/ (min 100 (max 0 (* 100 (/ (- event-left slider-left) width)))) increment)))))

 (defn pricing [app owner]
   (reify
     om/IDisplayName (display-name [_] "Pricing B")
     om/IRender
     (render [_]
-      (let [container-count (/ (om/get-state owner :drag-percent) pricing-increment)]
+      (let [container-count (/ (om/get-state owner :drag-percent) increment)]
         (html
           [:div.pricing.page {:on-mouse-up #(om/set-state! owner :dragging (utils/inspect false))
                               :on-mouse-down #(when (om/get-state owner :dragging)
@@ -74,7 +74,7 @@
                  [:span "You can run "]
                  [:strong "3"]
                  [:span " concurrent builds with "]
-                 [:strong container-count]
+                 [:strong {:class (when (> container-count 9) "double-digits")} container-count]
                  [:span " containers and "]
                  [:strong "2"]
                  [:span " parallelism. (Adjustable per project.)"]]


Remove printwritter impl on workspace events.

--- frontend/uxbox/data/workspace.cljs
+++ frontend/uxbox/data/workspace.cljs
@@ -48,11 +48,7 @@
     rs/UpdateEvent
     (-apply-update [_ state]
       (let [key (keyword (str (name toolname) "-enabled"))]
-        (update-in state [:workspace key] (fnil not false))))
-
-    IPrintWithWriter
-    (-pr-writer [mv writer _]
-      (-write writer "#<event:u.d.w/toggle-tool>"))))
+        (update-in state [:workspace key] (fnil not false))))))

 (defn toggle-toolbox
   "Toggle the visibility flag of the specified toolbox."
@@ -74,11 +70,7 @@
     (-apply-update [_ state]
       (if shape
         (assoc-in state [:workspace :drawing] shape)
-        (update-in state [:workspace] dissoc :drawing)))
-
-    IPrintWithWriter
-    (-pr-writer [mv writer _]
-      (-write writer "#<event:u.d.w/select-for-drawing>"))))
+        (update-in state [:workspace] dissoc :drawing)))))

 (defn select-shape
   "Mark a shape selected for drawing in the canvas."
@@ -146,11 +138,7 @@
             shape (merge shape props {:id sid :page pid})]
         (as-> state $
           (update-in $ [:pages-by-id pid :shapes] conj sid)
-          (assoc-in $ [:shapes-by-id sid] shape))))
-
-    IPrintWithWriter
-    (-pr-writer [mv writer _]
-      (-write writer "#<event:u.d.w/add-shape>"))))
+          (assoc-in $ [:shapes-by-id sid] shape))))))

 (defn initialize
   "Initialize the workspace state."
@@ -163,11 +151,7 @@
                :drawing nil
                :selected #{}
                :page pageid}]
-        (assoc state :workspace s)))
-
-    IPrintWithWriter
-    (-pr-writer [mv writer _]
-      (-write writer "#<event:u.d.w/initialize>"))))
+        (assoc state :workspace s)))))

 (defn move-shape
   "Mark a shape selected for drawing in the canvas."


Remove stray references, fix indentation.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -1576,7 +1576,6 @@
                :midi-handler (atom nil)
                :tap-tempo-handler (amidi/create-tempo-tap-handler (:metronome show))
                :overlays (controllers/create-overlay-state)
-               :next-overlay (atom 0)
                :move-listeners (atom #{})
                :grid-controller-impl (atom nil)}
               {:type :ableton-push})]
@@ -1614,7 +1613,7 @@
   as it is, binds it to the specified show using [[bind-to-show]]. If
   that controller ever gets disconnected, it will be re-bound once it
   reappears. Returns a watcher structure which can be passed
-  to [[cancel-auto-bind]] if you would like to stop it watching for
+  to [[deactivate]] if you would like to stop it watching for
   reconnections. The underlying controller mapping, once bound, can be
   accessed through the watcher's `:controller` key.

@@ -1661,7 +1660,7 @@
             (cancel-handler []
               (amidi/remove-new-device-handler! connection-handler)
               (when-let [device (:port-in @controller)]
-                        (amidi/remove-disconnected-device-handler! device disconnection-handler)))]
+                (amidi/remove-disconnected-device-handler! device disconnection-handler)))]

       ;; See if our Push seems to already be connected, and if so, bind to it right away.
       (when-let [found (first (amidi/filter-devices device-filter (amidi/open-inputs-if-needed!)))]


Add end effect buttons to effect list.

Add end effect buttons to effect list.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -656,6 +656,8 @@
               info (first fx-meta)
               cue (:cue info)]
           (write-display-cell controller 2 x (or (:name cue) (:name (first fx))))
+          (write-display-cell controller 3 x "End")
+          (aset (:next-top-pads controller) (* 2 x) (top-pad-state :dim :red))
           (when (seq (rest fx))
             (recur (rest fx) (rest fx-meta) (inc x)))))
       (do
@@ -1032,6 +1034,42 @@
                                      #(swap! (:next-text-buttons controller)
                                              assoc button (button-state button :bright))))

+(defn- handle-end-effect
+  "Process a tap on one of the pads which indicate the user wants to
+  end the associated effect."
+  [controller note]
+  (let [room (if (seq @(:metronome-mode controller)) 3 4)
+        fx-info @(:active-effects (:show controller))
+        fx (:effects fx-info)
+        fx-meta (:meta fx-info)
+        offset (- 4 room)
+        x (/ (- note 20) 2)
+        index (- x offset)]
+    (when (and (seq fx) (< index (count fx)))
+      (let [effect (get fx index)
+            info (get fx-meta index)]
+        (with-show (:show controller)
+          (show/end-effect! (:key info) :when-id (:id info)))
+        (add-overlay controller
+                     (reify IOverlay
+                       (captured-controls [this] #{note (inc note)})
+                       (captured-notes [this] #{})
+                       (adjust-interface [this controller]
+                         (write-display-cell controller 0 x "")
+                         (write-display-cell controller 1 x "Ending:")
+                         (write-display-cell controller 2 x (or (:name (:cue info)) (:name effect)))
+                         (write-display-cell controller 3 x "")
+                         (aset (:next-top-pads controller) (* 2 x) (top-pad-state :bright :red))
+                         (aset (:next-top-pads controller) (inc (* 2 x)) (top-pad-state :off))
+                         true)
+                       (handle-control-change [this controller message]
+                         (when (and (= (:note message) note) (zero? (:velocity message)))
+                           :done))
+                       (handle-note-on [this controller message]
+                         false)
+                       (handle-note-off [this controller message]
+                         false)))))))
+
 (defn- control-change-received
   "Process a control change message which was not handled by an
   interface overlay."
@@ -1046,6 +1084,10 @@
     (when (pos? (:velocity message))
       (enter-metronome-showing controller))

+    (20 22 24 26) ; Effect end pads
+    (when (pos? (:velocity message))
+      (handle-end-effect controller (:note message)))
+
     ;; 28 ; Master button

     29 ; Stop button


Fix tabindex property

Fix tabindex property

--- src/braid/core/client/ui/views/thread.cljs
+++ src/braid/core/client/ui/views/thread.cljs
@@ -318,7 +318,7 @@
              \uf00d]
             [:div.control.unread
              {:title "Mark Unread"
-              :tabindex 0
+              :tabIndex 0
               :role "button"
               :on-click (fn [e]
                           ; Need to preventDefault & propagation when using


Fix ambiguous column reference in generated resource query

This was causing resource queries to fail on postgres, but not on the
embedded database, which is why it wasn't caught by tests.

--- src/com/puppetlabs/cmdb/query/resource.clj
+++ src/com/puppetlabs/cmdb/query/resource.clj
@@ -40,7 +40,7 @@
                    "JOIN certname_catalogs USING(catalog) "
                    "LEFT OUTER JOIN resource_params rp "
                    "ON cr.resource = rp.resource "
-                   "WHERE (catalog,resource) IN "
+                   "WHERE (cr.catalog,cr.resource) IN "
                    sql)
         results (sql/with-connection db
                    (apply query-to-vec query params))


Detect dev environments and link directly to github auth (#1915)

* Detect dev environments and link directly to github auth

* Use dev client build detection instead of rendercontext env

* client-dev? is not a function

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -1,5 +1,6 @@
 (ns frontend.components.header
   (:require [frontend.async :refer [raise!]]
+            [frontend.config :as config]
             [frontend.components.common :as common]
             [frontend.components.forms :as forms]
             [frontend.components.license :as license]
@@ -220,7 +221,9 @@
                  [:li [:a.menu-item {:href "/dashboard"} "Back to app"]]]
                 [:ul.nav.navbar-nav.navbar-right
                  [:li
-                  [:a.login.login-link.menu-item {:href "/vcs-authorize/"
+                  [:a.login.login-link.menu-item {:href (if config/client-dev?
+                                                          (gh-public-scopes/add-private-repos-url)
+                                                          "/vcs-authorize/")
                                                   :on-click #((om/get-shared owner :track-event) {:event-type :login-clicked})
                                                   :title "Log In"}
                    "Log In"]]


set char limit to 120

set char limit to 120

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -29,7 +29,7 @@
     om/IRenderState
     (render-state [_ {:keys [issue-title submitting?]}]
       (let [{:keys [issue-db cust cast!]} (om/get-shared owner)
-            char-limit 140
+            char-limit 120
             chars-left (- char-limit (count issue-title))
             input-disabled? (or submitting?
                                 (not (utils/logged-in? owner))


Made start of new load a bit more conspicuous

--- src/midje/internal_ideas/project_state.clj
+++ src/midje/internal_ideas/project_state.clj
@@ -108,7 +108,7 @@
  (defn react-to-tracker! [state-tracker]
    (let [namespaces (load-key state-tracker)]
      (when (not (empty? namespaces))
-       (println (color/note "\n==========="))
+       (println (color/note "\n======================================================================"))
        (println (color/note "Loading " (pr-str namespaces)))
        (levelly/forget-past-results)
        (require-namespaces! namespaces


add some stuff to handle cyclic

add some stuff to handle cyclic

--- src/angelic/search/action_set/asplan.clj
+++ src/angelic/search/action_set/asplan.clj
@@ -136,6 +136,8 @@
         precond-vars (keys (dissoc precond-map effect-var))
         [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)]
     (assert (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars))
+#_    (util/assert-is (every? #(contains? #{nil :frozen} (state/get-var s (action-var %))) precond-vars)
+                    "%s" [name precond-map effect-map s])
     (env-util/make-factored-primitive
      [::Fire name]
      (into precond-map
@@ -310,12 +312,16 @@
   (let [c-val (state/get-var s v)
         dtg   (get-in dtgs [v c-val])
         child (current-child s cvm v)
-        d-val (-> (state/get-var s (action-var child)) :precond-map (util/safe-get v))]
+        d-val (-> (state/get-var s (action-var child)) :precond-map (get v))]
     ;;    (when greedy? #_ (util/assert-is (not (= c-val d-val)) "%s" (def *s* s)))
-    (if (= c-val d-val)
-      [(make-freeze-var-action v)]
-      (for [n-val (acyclic-succ-fn v c-val d-val), a (dtg n-val)]
-        (make-add-action-action a)))))
+    (if d-val
+      (if (= c-val d-val)
+        [(make-freeze-var-action v)]
+        (for [n-val (acyclic-succ-fn v c-val d-val), a (dtg n-val)]
+          (make-add-action-action a)))
+      ;; This should only arise in cyclic domains -- TODO: remove?
+      (add-actions s v dtgs))))
+

@@ -370,8 +376,9 @@
            dtgs          (sas-analysis/domain-transition-graphs sas-problem)
            simple-dtgs   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) dtgs)
            acyclic-succ-fn (partial possibly-acyclic-successors (HashMap.) simple-dtgs)]
-       (assert (graphs/dag? causal-graph))
-
+;       (assert (graphs/dag? causal-graph))
+       (assert (sas-analysis/unary? sas-problem))
+
        (ASPlanEnv.
         sas-problem
         (expand-initial-state (env/initial-state sas-problem) child-var-map (goal-action dtgs))
@@ -407,6 +414,10 @@
                 :else (assert "Unknown source type!")))))
         (env/goal-map sas-problem)
         causal-graph dtgs av-map child-var-map tsi acyclic-succ-fn))))
+
+(comment
+  (try [(make-fire-action-type s  edge-rule (first sources))] ;; TODO: rempve!
+                              (catch AssertionError e nil)))

 (defn make-naive-asplan-env
   "Replace the actions-fn in asplan-env with one that generates all legal actions,
@@ -456,7 +467,7 @@

-;; (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite 'angelic.search.action-set.asplan  'angelic.domains.sas-problems 'edu.berkeley.ai.util 'angelic.sas.hm-heuristic)
+;; (use 'angelic.env 'angelic.hierarchy 'angelic.search.textbook 'angelic.domains.taxi-infinite 'angelic.search.action-set.asplan  'angelic.domains.sas-problems 'angelic.sas 'angelic.sas.analysis 'edu.berkeley.ai.util 'angelic.sas.hm-heuristic)

 ;; (let [e (make-random-infinite-taxi-sas2 4 4 4 2)] (println (time (run-counted #(uniform-cost-search e)))) (println (time (run-counted #(asplan-solution-pair-name (uniform-cost-search (make-asplan-env e)))))))

@@ -467,7 +478,7 @@

  ; (doseq [[alg sp]  [[make-asplan-env asplan-solution-pair-name] [angelic.search.action-set.asplan-broken/make-asplan-env angelic.search.action-set.asplan-broken/asplan-solution-pair-name]] ] (println (time (run-counted #(sp (uniform-cost-search (alg (make-random-infinite-taxi-sas2 3 3 3 3))))))))

-
+; (-> (nth (vals (sas-sample-files 1)) 5) make-sas-problem-from-pddl unarize make-asplan-env interactive-search)


+TODO

+TODO

--- src/babel/francais/morphology/verbs.cljc
+++ src/babel/francais/morphology/verbs.cljc
@@ -7,6 +7,8 @@
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    [dag_unify.core :refer (copy dissoc-paths fail? get-in ref? strip-refs unify)]))
+
+;; TODO: imperfect ({:synsem {:infl :imperfect, :sem {:aspect :progressive, :tense :past}}})

 ;; TODO: convert to (babel.morphology/conjugation)
 ;; (see babel.latin.morphology for an example of how to use babel.morphology/conjugation)


Have pages receive page info via params

Have pages receive page info via params

--- src/braid/core/client/ui/views/main.cljs
+++ src/braid/core/client/ui/views/main.cljs
@@ -11,23 +11,25 @@
    [re-frame.core :refer [dispatch subscribe]]))

 (defn page-view []
-  (let [id (@(subscribe [:page]) :type)]
+  (let [page @(subscribe [:page])
+        id (:type page)]
     (case id
       :readonly [readonly-inbox-page-view]
       :login [gateway-view]
       :create-group [create-group-page-view]
       (when-let [view (pages/get-view id)]
-        [view]))))
+        [view page]))))

 (defn readonly-page-view
   []
-  (let [id (:type @(subscribe [:page]))]
+  (let [page @(subscribe [:page])
+        id (:type page)]
     (case id
       (:inbox :readonly) [readonly-inbox-page-view]
       :login [gateway-view]
       :create-group [create-group-page-view]
       (when-let [view (pages/get-view id)]
-        [view]))))
+        [view page]))))

 (defn root-views []
   (into


Genetic operators track ages.

Genetic operators track ages.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -130,6 +130,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -155,6 +156,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -189,6 +191,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -224,6 +227,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -256,6 +260,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -294,6 +299,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -320,6 +326,7 @@
         new-genome (mapv token-mutator (:genome ind))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -352,6 +359,7 @@
           new-genome (mapv close-mutator (:genome ind))]
       (make-individual :genome new-genome
                        :history (:history ind)
+                       :age (inc (:age ind))
                        :ancestors (if maintain-ancestors
                                     (cons (:genome ind) (:ancestors ind))
                                     (:ancestors ind))))))
@@ -376,6 +384,7 @@
           new-genome (mapv silent-mutator (:genome ind))]
       (make-individual :genome new-genome
                        :history (:history ind)
+                       :age (inc (:age ind))
                        :ancestors (if maintain-ancestors
                                     (cons (:genome ind) (:ancestors ind))
                                     (:ancestors ind))))))
@@ -393,6 +402,7 @@
                                      (:genome ind))))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -414,6 +424,7 @@
                                     (:genome ind))))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -442,6 +453,7 @@
                                      after-addition)))]
     (make-individual :genome new-genome
                      :history (:history ind)
+                     :age (inc (:age ind))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome ind) (:ancestors ind))
                                   (:ancestors ind)))))
@@ -473,6 +485,9 @@
                                      after-combination)))]
     (make-individual :genome new-genome
                      :history (:history parent1)
+                     :age ((:age-combining-function argmap)
+                           (inc (:age parent1))
+                           (inc (:age parent2)))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome parent1) (:ancestors parent1))
                                   (:ancestors parent1)))))
@@ -509,6 +524,9 @@
                                 (dec iteration-budget)))))]
     (make-individual :genome new-genome
                      :history (:history parent1)
+                     :age ((:age-combining-function argmap)
+                           (inc (:age parent1))
+                           (inc (:age parent2)))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome parent1) (:ancestors parent1))
                                   (:ancestors parent1)))))
@@ -532,6 +550,9 @@
                                       genome1)))]
     (make-individual :genome new-genome
                      :history (:history parent1)
+                     :age ((:age-combining-function argmap)
+                           (inc (:age parent1))
+                           (inc (:age parent2)))
                      :ancestors (if maintain-ancestors
                                   (cons (:genome parent1) (:ancestors parent1))
                                   (:ancestors parent1)))))
@@ -564,6 +585,9 @@
                                  long-genome)))]
       (make-individual :genome new-genome
                        :history (:history parent1)
+                       :age ((:age-combining-function argmap)
+                             (inc (:age parent1))
+                             (inc (:age parent2)))
                        :ancestors (if maintain-ancestors
                                     (cons (:genome parent1) (:ancestors parent1))
                                     (:ancestors parent1))))))
@@ -833,6 +857,9 @@
                          [])))]
     (assoc (make-individual :genome new-genome
                             :history (:history parent1)
+                            :age ((:age-combining-function argmap)
+                                  (inc (:age parent1))
+                                  (inc (:age parent2)))
                             :ancestors (if maintain-ancestors
                                          (cons (:genome parent1) (:ancestors parent1))
                                          (:ancestors parent1)))
@@ -883,6 +910,9 @@
                                         new-genome
                                         [])
                               :history (:history parent1)
+                              :age ((:age-combining-function argmap)
+                                    (inc (:age parent1))
+                                    (inc (:age parent2)))
                               :ancestors (if maintain-ancestors
                                            (cons (:genome parent1) (:ancestors parent1))
                                            (:ancestors parent1)))
@@ -897,3 +927,4 @@

+


Finished reason goes on meta

Finished reason goes on meta

--- src/com/wsscode/pathom/connect/test.cljc
+++ src/com/wsscode/pathom/connect/test.cljc
@@ -324,10 +324,10 @@
         res-keys  (set (keys resolvers))
         sym-calls #(resolver-calls env %)
         mark-done (fn [sym reason]
-                    (swap! data-bank assoc-in [::call-history sym ::resolver-finished-by] reason))]
+                    (swap! data-bank update-in [::call-history sym] (fn [x] (vary-meta (or x {}) assoc ::resolver-finished-by reason))))]
     (loop []
       (let [missing (->> res-keys
-                         (remove (comp ::resolver-finished-by sym-calls))
+                         (remove (comp ::resolver-finished-by meta sym-calls))
                          (sort-by #(count-success-calls env %)))]
         (if (seq missing)
           (let [sym (first missing)


(TK-130) Test optimization

(TK-130) Test optimization

--- src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
+++ src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
@@ -360,12 +360,12 @@
   otherwise use the default."
   [config   :- WebserverRawConfig
    num-cpus :- schema/Int]
-  (let [calc-max-threads (max (calculate-required-threads config num-cpus)
-                              default-max-threads)]
-    (or (:max-threads config)
-        (do (log/warn "Thread pool size not configured so using a size of "
-                      calc-max-threads)
-            calc-max-threads))))
+  (or (:max-threads config)
+      (let [calc-max-threads (max (calculate-required-threads config num-cpus)
+                                  default-max-threads)]
+        (log/warn "Thread pool size not configured so using a size of "
+                  calc-max-threads)
+        calc-max-threads)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public


(TK-130) Renamed function for clarity

(TK-130) Renamed function for clarity

--- src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
+++ src/puppetlabs/trapperkeeper/services/webserver/jetty9_config.clj
@@ -342,7 +342,7 @@
     (count (filter true? connectors))))

 (schema/defn ^:always-validate
-  calculate-minimum-threads :- schema/Int
+  calculate-required-threads :- schema/Int
   "Calculate the number threads needed to operate based on the number of cores
   abvailable and the number of connectors present."
   [config   :- WebserverRawConfig
@@ -358,7 +358,7 @@
   otherwise use the default."
   [config   :- WebserverRawConfig
    num-cpus :- schema/Int]
-  (let [calc-max-threads (max (calculate-minimum-threads config num-cpus)
+  (let [calc-max-threads (max (calculate-required-threads config num-cpus)
                               default-max-threads)]
     (or (:max-threads config)
         (do (log/warn "Thread pool size not configured so using a size of "


revert to old scheme of visibility of docs

--- src/cljs/work_sessions/components/proxy_viewer_page.cljs
+++ src/cljs/work_sessions/components/proxy_viewer_page.cljs
@@ -23,20 +23,21 @@

          [headers-view]

-         [:div.documentation-container
-          [:div.documentation
-           [:div.responsive-embed.widescreen
-            [:iframe
-             {:width 560
-              :height 315
-              ;; vnd.youtube://
-              ;; :src "vnd.youtube://www.youtube.com/watch?v=Qar_jUm7yhQ?autoplay=1"
-              :src "https://www.youtube.com/embed/TuGG9Wts-zA?autoplay=1"
-              :frame-border 0
-              :auto-play 1
-              :controls 0
-              :loop 1
-              :allow-full-screen true}]]]]])})))
+         (when @is-docs-visible?
+           [:div.documentation-container
+            [:div.documentation
+             [:div.responsive-embed.widescreen
+              [:iframe
+               {:width 560
+                :height 315
+                ;; vnd.youtube://
+                ;; :src "vnd.youtube://www.youtube.com/watch?v=Qar_jUm7yhQ?autoplay=1"
+                :src "https://www.youtube.com/embed/TuGG9Wts-zA?autoplay=1&loop=1&controls=0"
+                :frame-border 0
+                :auto-play 1
+                :loop 1
+                :controls 0
+                :allow-full-screen true}]]]])])})))

 ;; (defn proxy-viewer-page []


Rewrite pepa.components.document to a more powerful style.

We need that in a different branch anyway - sorry for throwing away some work.

--- src-cljs/pepa/components/document.cljs
+++ src-cljs/pepa/components/document.cljs
@@ -11,31 +11,34 @@
   (:require-macros [cljs.core.async.macros :refer [go]])
   (:import [goog.i18n DateTimeFormat DateTimeParse]))

-(defmulti ^:private meta-row (fn [kw val] kw))
+(defmulti meta-value (fn [[kw val] owner opts] kw))

-(defmethod meta-row :default [kw val]
-  [(s/capitalize (name kw)) val])
+(ui/defcomponentmethod meta-value :default [[key value] _ _]
+  (render [_]
+    [:span.value {:key "value", :title (str value)}
+     value]))

 (let [formatter (DateTimeFormat. "dd.MM.yyyy HH:mm")]
-  (defn format-date [^Date date]
+  (defn format-datetime [^Date date]
     (when date
       (.format formatter date))))

-(defmethod meta-row :created [kw val]
-  [(s/capitalize (name kw)) (format-date val)])
-(defmethod meta-row :modified [kw val]
-  [(s/capitalize (name kw)) (format-date val)])
-
 (let [formatter (DateTimeFormat. "dd.MM.yyyy")]
-  (defmethod meta-row :document-date [kw val]
-    [(s/replace (s/capitalize (name kw)) #"-" " ") (if val
-                                                     (.format formatter val)
-                                                     "Click here to set a date")]))
-
-(let [formatter (DateTimeFormat. "yyyy-MM-dd")]
-  (defn ^:private format-datepicker [date]
+  (defn ^:private format-date [^Date date]
     (when date
       (.format formatter date))))
+
+(ui/defcomponentmethod meta-value :created [[key date] _ _]
+  (render [_]
+    (let [value (format-datetime date)]
+      [:span.value {:key "value", :title value}
+       value])))
+
+(ui/defcomponentmethod meta-value :modified [[key date] _ _]
+  (render [_]
+    (let [value (format-datetime date)]
+      [:span.value {:key "value", :title value}
+       value])))

 (let [parser (DateTimeParse. "yyyy-MM-dd")]
   (defn string->date [date-string]
@@ -44,61 +47,57 @@
         (.parse parser date-string date)
         date))))

-(defn ^:private property-changed [document prop value]
-  (go
-    (<! (api/update-document! (assoc @document prop value)))))
+(let [formatter (DateTimeFormat. "yyyy-MM-dd")]
+  (defn ^:private date->date-picker-value [^Date date]
+    (.format formatter date)))

-(ui/defcomponent meta-item [{:keys [name title value]} _]
-  (render [_]
-    [:li {:class name, :key name}
-     [:span.title {:key "title"} title]
-     [:span.value {:key "value", :title (str value)}
-      value]]))
+(defn ^:private document-date-changed [owner e]
+  (let [value e.currentTarget.value
+        date (when-not (s/blank? value) (string->date value))]
+    (om/set-state! owner :date date)))

-(ui/defcomponent ^:private date-picker [{:keys [name title value]}
-                                        owner
-                                        {:keys [update-fn]}]
+(defn ^:private store-document-date! [owner date e]
+  (let [callback (om/get-state owner :change-callback)]
+    (when (fn? callback)
+      (callback :document-date date))
+    (om/set-state! owner :editing? false)))
+
+(ui/defcomponentmethod meta-value :document-date [[_ date] owner _]
   (init-state [_]
-    {:editing? false})
-  (render-state [_ {:keys [editing? val]}]
-    [:li {:class name
-          :key name
-          :on-click #(om/set-state! owner :editing? true)}
-     [:span.title {:key "title"} title]
-     (if-not editing?
-       [:span.value {:key "value", :title (str value)} value]
-       [:form {:on-key-down (fn [e]
-                              (when (= keycodes/ENTER e.keyCode)
-                                (om/set-state! owner :editing? false)
-                                (update-fn :document-date (string->date val))))
-               :on-change (fn [e] (om/set-state! owner :val e.target.value))
-               :on-blur (fn [e] (do
-                                  (om/set-state! owner :editing? false)
-                                  (update-fn :document-date (string->date val))))}
-        [:input {:type "date"
-                 :key "value"
-                 :value val}]
-        [:input {:type "button"
-                 :value "Reset"
-                 :on-click #(do
-                              (om/set-state! owner :val nil)
-                              (update-fn :document-date nil))}]])]))
+    {:editing? false
+     :date (om/value date)})
+  (render-state [_ {:keys [editing? date change-callback]}]
+    (if-not editing?
+      (let [value (when date (format-date date))]
+        [:span.value {:key "value", :title (str value)
+                      :on-click (fn [e] (om/set-state! owner :editing? true))}
+         (or value "Click to set")])
+      (let [on-submit! (partial store-document-date! owner date)]
+        [:form {:on-submit on-submit! :on-blur on-submit!}
+         [:input {:type "date"
+                  :key "date-input"
+                  :on-change (partial document-date-changed owner)
+                  :value (when date
+                           (date->date-picker-value date))}]]))))
+
+(ui/defcomponent meta-item [[prop value] owner _]
+  (render-state [_ state]
+    (let [name (name prop)
+          title (s/capitalize name)]
+      [:li {:class name, :key name}
+       [:span.title {:key "title"} title]
+       (om/build meta-value [prop value]
+                 {:state state})])))
+
+(defn ^:private property-changed! [document property value]
+  (assert (contains? #{:title :document-date} property))
+  (println "Updating property" property "on document" (:id @document))
+  (api/update-document! (assoc @document property value)))

 (ui/defcomponent meta-table [document]
   (render [_]
     [:ul.meta
      (for [prop [:title :created :modified :document-date :creator :size]]
-       (let [name (name prop)
-             [title value] (meta-row prop (get document prop))
-             data {:name name
-                   :title title
-                   :value value}]
-         (if-not (= name "document-date")
-           (om/build meta-item data)
-           (om/build date-picker
-                     data
-                     {:state
-                      {:val (format-datepicker (prop document))}
-                      :opts
-                      {:update-fn (partial property-changed document)}}))))]))
+       (om/build meta-item [prop (get document prop)]
+                 {:state {:change-callback (partial property-changed! document)}}))]))


Fix tests.

Fix tests.

--- test/clj/hatnik/selenium/projects_test.clj
+++ test/clj/hatnik/selenium/projects_test.clj
@@ -31,6 +31,8 @@
 (defn create-project [driver name]
   (.click (find-element driver "#add-project"))
   (wait-until-dialog-visible driver :project)
+  ; Switch project type to regular.
+  (.click (find-element driver "input[type=radio][value=regular]"))
   (set-project-name-field driver name)
   (.click (find-element driver
                         "#iModalProjectMenu .modal-footer .btn-primary"))


New tests: test-format-seconds-1

New tests: test-format-seconds-1

--- test/clj_calendar/format_datetime_test.clj
+++ test/clj_calendar/format_datetime_test.clj
@@ -192,3 +192,10 @@
               "2 minutes and 2 seconds ago"    (format-minutes 2 2)
               "2 minutes and 100 seconds ago"  (format-minutes 2 100))))

+(deftest test-format-seconds-1
+    "Check the function clj-calendar.format-datetime/format-seconds."
+    (testing "the function clj-calendar.format-datetime/format-seconds."
+        (are [x y] (= x y)
+              "one second ago"                 (format-seconds 1)
+              "2 seconds ago"                  (format-seconds 2))))
+


Test nilable

Test nilable

--- test/cljc/spec_tools/json_schema_test.cljc
+++ test/cljc/spec_tools/json_schema_test.cljc
@@ -64,8 +64,8 @@
     ;; keys*
     (is (= (jsc/to-json (s/map-of string? clojure.core/integer?))
            {:type "object" :additionalProperties {:type "integer"}}))
-    ;; nilable
-    )
+    (is (= (jsc/to-json (s/nilable string?))
+           {:oneOf [{:type "string"} {:type "null"}]})))
   (testing "failing clojure.specs"
     (is (not= (jsc/to-json (s/coll-of (s/tuple string? any?) :into {}))
               {:type "object", :additionalProperties {:type "string"}}))))


Update data selectors.

Update data selectors.

--- src/cljs/hatnik/web/client/z_actions.cljs
+++ src/cljs/hatnik/web/client/z_actions.cljs
@@ -118,7 +118,7 @@
        #(common-update-callback "Action don't deleted!" {} %))))

 (defn ^:export delete-project []
-  (let [project-id (:current-project (deref state/app-state))]
+  (let [project-id (-> (deref state/app-state) :ui :current-project)]
     (.modal ($ :#iModalProjectMenu) "hide")
     (ajax
      (str "/api/projects/" project-id) "DELETE"
@@ -126,7 +126,7 @@
          #(common-update-callback "Project don't deleted!" {} %)))))

 (defn ^:export update-project []
-  (let [project-id (:current-project (deref state/app-state))
+  (let [project-id (-> (deref state/app-state) :ui :current-project)
         new-name (get-data-from-input "project-name-edit-input")]
     (.modal ($ :#iModalProjectMenu) "hide")
     (ajax


Minor ui fix

Minor ui fix

--- src/cljs/salava/badgeIssuer/ui/modal.cljs
+++ src/cljs/salava/badgeIssuer/ui/modal.cljs
@@ -111,7 +111,7 @@
                               [:span.close {:aria-hidden "true" :dangerouslySetInnerHTML {:__html "×"}}]]])))
                 [:div.selected-users-container] @selected-users)]
        [:div#social-tab.panel-footer
-          [:button.btn.btn-primary.btn-btn-bulky
+          [:button.btn.btn-primary.btn-bulky
            {:data-dismiss "modal"
             :on-click #(issue-selfie-badge state (fn []
                                                    (session/put! :issue-event {:badge (select-keys badge [:name :image]) :recipient_count (count @selected-users)})))}


Make the manifest correctly

Make the manifest correctly

--- src/clojure/leiningen/new/libgdx_java.clj
+++ src/clojure/leiningen/new/libgdx_java.clj
@@ -20,6 +20,8 @@
               :name (project-name name)
               :package-name package-name
               :class-name class-name
+              :desktop-class-name desktop-class-name
+              :android-class-name android-class-name
               :namespace main-ns
               :desktop-namespace desktop-ns
               :android-namespace android-ns


fix initi val capture

fix initi val capture

--- src/clojure/zensols/actioncli/dynamic.clj
+++ src/clojure/zensols/actioncli/dynamic.clj
@@ -51,7 +51,7 @@
   See [[defa]], [[defnc-]] and [[undef]]."
   ([sym init-value]
    `(let [msym# (quote ~sym)]
-      (dyn-init-var *ns* msym# (quote ~init-value)))))
+      (dyn-init-var *ns* msym# ~init-value))))

 (defmacro defa
   "Just like [[defnc]] but the initialization value is an atom created
@@ -63,7 +63,7 @@
       (dyn-init-var *ns* msym# (atom nil))))
   ([sym init-value]
    `(let [msym# (quote ~sym)]
-      (dyn-init-var *ns* msym# (atom (quote ~init-value))))))
+      (dyn-init-var *ns* msym# (atom ~init-value)))))

 (defmacro defnc-
   "Create a private variable binding out of **sym** that doesn't already exist
@@ -72,7 +72,7 @@
   See [[defa-]] and [[undef]]."
   ([sym init-value]
    `(let [msym# (with-meta (quote ~sym) {:private true})]
-      (dyn-init-var *ns* msym# (quote ~init-value)))))
+      (dyn-init-var *ns* msym# ~init-value))))

 (defmacro defa-
   "Just like [[defnc-]] but the initialization value is an atom created
@@ -84,7 +84,7 @@
       (dyn-init-var *ns* msym# (atom nil))))
   ([sym init-value]
    `(let [msym# (with-meta (quote ~sym) {:private true})]
-      (dyn-init-var *ns* msym# (atom (quote ~init-value))))))
+      (dyn-init-var *ns* msym# (atom ~init-value)))))

 (defmacro undef
   "Unbind a variable in the current namespace.  Just like:


Add explicit AOT for setup namespace

Add explicit AOT for setup namespace

--- src/leiningen/new/mr_clojure/project.clj
+++ src/leiningen/new/mr_clojure/project.clj
@@ -93,4 +93,7 @@
                     :sources {:source [{:location "scripts/service/{{lower-name}}"
                                         :destination "{{lower-name}}"}]}}]}

+
+  :aot [{{name}}.setup]
+
   :main {{name}}.setup)


Added re-implementation of random-ints (ints in FPINS) via rng-sequence - added some comments

--- src/fpinscala/purely_functional_state.clj
+++ src/fpinscala/purely_functional_state.clj
@@ -196,11 +196,11 @@
 ;UPDATE [29.10.2015.] As per fpins variant (see below) fold-right is quite ok in this case as well
 ;fpins
 (defn rng-sequence-fpins
-  "sequence function for exercise 6."
+  "sequence function for exercise 6.7 FPINS variant"
   [fs]
-  (fpinscala.strictness-and-laziness/fold-right
-    (unit '())
-    #(map-rng-2 % %2 (fn [a b] (cons a b)))
+  (fpinscala.strictness-and-laziness/fold-right             ;Notice that this variant is using fold-right
+    (unit '())                                              ;Check out that "unit-produced" function is used as z value (now - it wouldn't be really
+    #(map-rng-2 % %2 (fn [a b] (cons a b)))                 ;correct to say it is "initial" but rather neutral (or terminating?) element
     fs))
 ;THIS WORKS!!! - THUS IN TERMS OF FPINS (AS FAR AS I UNDERSTOOD) Z IS UNIT/NEUTRAL ELEMENT


Chapter 6 - Solved 6.1 (but I am not really sure I've handled corner case of Int.MinValue as it is assumed/correctly)

--- src/fpinscala/purely_functional_state.clj
+++ src/fpinscala/purely_functional_state.clj
@@ -8,6 +8,11 @@
   (fn []
     (simple-rng seed)))

+(defn- make-result
+  "Auxiliary function to avoid same map creation all over the place"
+  [n nxt-rng]
+  {:n n :nxt-rng nxt-rng})
+
 (defn- simple-rng
   "As per listing 6.2 from FPINS"
   [^long seed]
@@ -17,7 +22,14 @@
         ;to make this working same way as in Scala/FPINS option
         nxt-rng (make-simple-rng nseed)
         n (.intValue (unsigned-bit-shift-right nseed 16))]
-    {:n n :nxt-rng nxt-rng}))
-
+    (make-result n nxt-rng)))

 ;6.1
+;mine
+(defn non-negative-int
+  "Generates random integer between 0 and Int.maxValue (inclusive)"
+  [rng]
+  (let [{next-int :n nxt-rng :nxt-rng} (rng)]
+    (if (> next-int Integer/MIN_VALUE)
+      (make-result (Math/abs ^int next-int) nxt-rng)
+      (make-result Integer/MAX_VALUE nxt-rng))))


Improve error messages slightly

Improve error messages slightly

--- src/refactor_nrepl/rename_file_or_dir.clj
+++ src/refactor_nrepl/rename_file_or_dir.clj
@@ -210,18 +210,19 @@

 (defn- assert-friendly
   [old-path new-path]
-  (cond
-    (or (str/blank? old-path) (str/blank? new-path))
-    (throw (IllegalArgumentException. "Can't move empty path!"))
-
-    (or (and (fs/file? old-path) (fs/directory? old-path))
-        (and (fs/directory? old-path) (fs/file? old-path)))
-    (throw (ex-info "old-path and new-path has to be of same type (dir-dir or file-file)!"
-                    {:old-path old-path :new-path new-path}))
-    (and (not (fs/directory? old-path))
-         (not= (fs/extension old-path) (fs/extension new-path)))
-    (throw (ex-info (str "Can't change file extension when moving! ")
-                    {:old-path old-path :new-path new-path}))))
+  (let [exception-data {:old-path old-path :new-path new-path}]
+    (cond
+      (or (str/blank? old-path) (str/blank? new-path))
+      (throw (ex-info "Can't act on empty path!" exception-data))
+
+      (or (and (fs/file? old-path) (fs/directory? old-path))
+          (and (fs/directory? old-path) (fs/file? old-path)))
+      (throw (ex-info "Can only move dir to dir or file to file!" exception-data))
+
+      (and (not (fs/directory? old-path))
+           (not= (fs/extension old-path) (fs/extension new-path)))
+      (throw (ex-info (str "Can't change file extension when moving! ")
+                      exception-data)))))

 (defn rename-file-or-dir
   "Renames a file or dir updating all dependent files.


Remove created-at from daily report

Remove created-at from daily report

--- src/servisne_info/tasks/daily_report.clj
+++ src/servisne_info/tasks/daily_report.clj
@@ -5,7 +5,7 @@
             [servisne-info.tasks.task-definition :refer [deftask]]))

 (defn- format-event-data [event]
-  (l/format-data (dissoc event :_id)))
+  (l/format-data (dissoc event :_id :created-at)))

 (defn send-daily-report []
   (let [events (repo/find-events-for-yesterday)]


Renamed val

Renamed val

--- src/trumpet_server/domain/trumpeteer.clj
+++ src/trumpet_server/domain/trumpeteer.clj
@@ -27,7 +27,7 @@
    :max-distance-meters - Optional distance (in meters) or 200 will be used"
   (trumpet! [this args]))

-(def max-distance 200)
+(def default-max-distance 200)

 (defrecord Trumpeteer [id latitude longitude]
   Location Trumpet
@@ -40,11 +40,11 @@
           sum (+ lhs rhs)
           dist (-> sum Math/acos rad2deg (* 60 1.1515))]
       (convert-to-unit dist (or distance-unit :meters))))
-  (trumpet! [this {:keys [trumpet trumpetees broadcast-fn max-distance-meters] :or {max-distance-meters max-distance}}]
+  (trumpet! [this {:keys [trumpet trumpetees broadcast-fn max-distance-meters] :or {max-distance-meters default-max-distance}}]
     {:pre [trumpet trumpetees broadcast-fn]}
     (let [targets-without-this (filter #(not= (:id %) (:id this)) trumpetees)
           targets-with-distance (map #(assoc % :distance (distance-to this % :meters)) targets-without-this)
-          targets-in-range (filter #(<= (:distance %) (or max-distance-meters max-distance)) targets-with-distance)
+          targets-in-range (filter #(<= (:distance %) (or max-distance-meters default-max-distance)) targets-with-distance)
           messages-to-broadcast (map #(into {} {:id (:id %) :message {:message trumpet :distanceFromSource (:distance %)}}) targets-in-range)]
       (doseq [message messages-to-broadcast]
         (broadcast-fn (:id message) (:message message))))))