use some? opposed to not nil

use some? opposed to not nil

--- src/hundred_pushups/core.cljc
+++ src/hundred_pushups/core.cljc
@@ -169,8 +169,6 @@
 (defn format-whitelist-row [row]
   (str (name(first row)) ": " (clojure.string/join "-" (last row))))

-(def not-nil? (complement nil?))
-
 (defn valid-hour-time [input]
-  (and (not-nil? input)
-  (not-nil? (re-matches #"\d+(am|pm)" input))))
+  (and (some? input)
+  (some? (re-matches #"\d+(am|pm)" input))))


Actually fix panel swiping on mobile

Actually fix panel swiping on mobile

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

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

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

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


WIP - Evolution du bot CSB en Clojure avec l'objectif d'améliorer le classement en ligue argent

--- clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
+++ clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
@@ -30,28 +30,30 @@
 (defn after [val1 val2] (if (> (- val2 val1) 0) true false))
 (defn before [val1 val2] (if (< (- val2 val1) 0) true false))

-(def max-shield-usage (atom 5))
-(def last-shield-usage (atom 0))
-(def boost-used? (atom false))
-(def game-loop-counter (atom 0))
-(def last-boost-value (atom "0"))
+(defn compute-boost-from-angle [next-checkpoint-angle]
+  (str (convert-to-int (* (Math/sin (convert-degree-to-radian (Math/abs next-checkpoint-angle))) 100))))
+
+;(def max-shield-usage (atom 5))
+;(def last-shield-usage (atom 0))
+;(def boost-used? (atom false))
+;(def game-loop-counter (atom 0))
+;(def last-boost-value (atom "0"))

 ;;Compute a boost value between 0 and 100
 (defn compute-boost [next-checkpoint-distance next-checkpoint-angle]
   (cond
-    ;(< next-checkpoint-distance 600) "0"
     (>= (Math/abs next-checkpoint-angle) 90) "0"
-    (> (Math/abs next-checkpoint-angle) 72) "20"
-    (> (Math/abs next-checkpoint-angle) 54) "40"
-    (> (Math/abs next-checkpoint-angle) 36) "60"
-    (> (Math/abs next-checkpoint-angle) 18) "80"
+    ;(> (Math/abs next-checkpoint-angle) 72) "20"
+    ;(> (Math/abs next-checkpoint-angle) 54) "40"
+    ;(> (Math/abs next-checkpoint-angle) 36) "60"
+    ;(> (Math/abs next-checkpoint-angle) 18) "80"
     (<= (Math/abs next-checkpoint-angle) 18) "100"
-    true "100"))
+    ;true "100"))
+    true (compute-boost-from-angle next-checkpoint-angle)))

 (defn- use-boost? [next-checkpoint-distance next-checkpoint-angle boost-used? game-loop-counter last-shield-usage last-boost-value]
   (and
     (not @boost-used?)
-    ;(> @game-loop-counter 3)
     (< (Math/abs next-checkpoint-angle) 10)
     (> next-checkpoint-distance 4000)
     (and (not (= @last-boost-value "SHIELD")) (not (= @last-boost-value "BOOST")) (= @last-shield-usage 0) (= (Integer/parseInt @last-boost-value) 100))))
@@ -67,49 +69,55 @@
     true (compute-boost next-checkpoint-distance next-checkpoint-angle)))

 (defn -main [& args]
-  (while true
-    (let [x (read) y (read)
-          nextCheckpointX (read) nextCheckpointY (read)
-          nextCheckpointDist (read) nextCheckpointAngle (read)
-          opponentX (read) opponentY (read)
-          opponent-distance (distance x y opponentX opponentY)]
+  (let [max-shield-usage (atom 5)
+        last-shield-usage (atom 0)
+        boost-used? (atom false)
+        game-loop-counter (atom 0)
+        last-boost-value (atom "0")]
+    (while true
+      (let [x (read) y (read)
+            nextCheckpointX (read) nextCheckpointY (read)
+            nextCheckpointDist (read) nextCheckpointAngle (read)
+            opponentX (read) opponentY (read)
+            opponent-distance (distance x y opponentX opponentY)]
       ; nextCheckpointX: x position of the next check point
       ; nextCheckpointY: y position of the next check point
       ; nextCheckpointDist: distance to the next checkpoint
       ; nextCheckpointAngle: angle between your pod orientation and the direction of the next checkpoint

-      (swap! game-loop-counter inc-atom)
-      (if (> @last-shield-usage 0)
-        (swap! last-shield-usage dec-atom))
+        (swap! game-loop-counter inc-atom)
+        (if (> @last-shield-usage 0)
+          (swap! last-shield-usage dec-atom))

-      ; (binding [*out* *err*]
-      ;   (println "Debug messages..."))
-      ;(binding [*out* *err*]
-      ;  (println (str "Has the boost been used ? : " @boost-used?))
-      ;  (println (str "Next check point distance coordinates : (" nextCheckpointX "," nextCheckpointY ")"))
-      ;  (println (str "Given next check point distance : " nextCheckpointDist))
-      ;  (println (str "Calculated next check point distance : " (distance x y nextCheckpointX nextCheckpointY)))
-      ;  (println (str "Pod angle with checkpoint : " nextCheckpointAngle))
-      ;  (println (str "Calculated Pod angle with checkpoint : " (angle-between-2-points x y nextCheckpointX nextCheckpointY)))
-      ;  (println (str "Pod Position : (" x "," y ")"))
-      ;  (println (str "Opponent pod Position : (" opponentX "," opponentY ")"))
-      ;  (println (str "Opponent distance : " opponent-distance))
-      ;  (println (str "Calculated Pod angle with opponent : " (angle-between-2-points x y opponentX opponentY)))
-      ;  (println (str "Max Shield Usage : " @max-shield-usage))
-      ;  (println (str "Last Shield Usage : " @last-shield-usage))
-      ;  (println (str "Game loop counter : " @game-loop-counter))
-      ;  (println (str "Last boost value : " @last-boost-value)))
+        ; (binding [*out* *err*]
+        ;   (println "Debug messages..."))
+        ;(binding [*out* *err*]
+        ;  (println (str "Has the boost been used ? : " @boost-used?))
+        ;  (println (str "Next check point distance coordinates : (" nextCheckpointX "," nextCheckpointY ")"))
+        ;  (println (str "Given next check point distance : " nextCheckpointDist))
+        ;  (println (str "Calculated next check point distance : " (distance x y nextCheckpointX nextCheckpointY)))
+        ;  (println (str "Pod angle with checkpoint : " nextCheckpointAngle))
+        ;  (println (str "Calculated Pod angle with checkpoint : " (angle-between-2-points x y nextCheckpointX nextCheckpointY)))
+        ;  (println (str "Pod Position : (" x "," y ")"))
+        ;  (println (str "Opponent pod Position : (" opponentX "," opponentY ")"))
+        ;  (println (str "Opponent distance : " opponent-distance))
+        ;  (println (str "Calculated Pod angle with opponent : " (angle-between-2-points x y opponentX opponentY)))
+        ;  (println (str "Max Shield Usage : " @max-shield-usage))
+        ;  (println (str "Last Shield Usage : " @last-shield-usage))
+        ;  (println (str "Game loop counter : " @game-loop-counter))
+        ;  (println (str "Last boost value : " @last-boost-value)))

-      ; You have to output the target position
-      ; followed by the power (0 <= thrust <= 100)
-      ; i.e.: "x y thrust"
-      (print nextCheckpointX)
-      (print " ")
-      (print nextCheckpointY)
-      (print " ")
-      (reset! last-boost-value (compute-action
+        ; You have to output the target position
+        ; followed by the power (0 <= thrust <= 100)
+        ; i.e.: "x y thrust"
+        (print nextCheckpointX)
+        (print " ")
+        (print nextCheckpointY)
+        (print " ")
+        (reset! last-boost-value
+                (compute-action
                                  nextCheckpointX nextCheckpointY
                                  nextCheckpointDist nextCheckpointAngle
                                  x y
@@ -119,5 +127,5 @@
                                  max-shield-usage
                                  last-shield-usage
                                  last-boost-value))
-      (print @last-boost-value))
-    (println "")))+        (print @last-boost-value))
+      (println ""))))


Missed another. Doc update.

Missed another. Doc update.

--- src/algebolic/expression/core.clj
+++ src/algebolic/expression/core.clj
@@ -35,6 +35,7 @@
 ;; - the differentiator (differentiation.clj)
 ;; - possibly the computer algebra code (algebra.clj)
 ;; - the Mathematica export code (mma.clj)
+;; - the LaTex export code (render.clj)
 (def function-symbols
   "The primitive set of functions that algebolic expressions can be built from."
   [{:name :plus :arity 2}


Add a list of commands that updates as user types

--- src/bolt/core.cljs
+++ src/bolt/core.cljs
@@ -12,6 +12,8 @@

 (def app-state (atom {:user-input ""
                       :event-ch (chan 10)
+                      :all-commands (map (fn [[k v]] (assoc v :name (name k)))
+                                         (:commands config/config))
                       :mic-path "img/mic.gif"}))
 (def commands-index
   (memoize (fn []
@@ -121,20 +123,37 @@
                            (handle-event app-state event event-data))))
                  state)})

-(rum/defc bolt-app < event-loop rum/reactive []
-  (let [{:keys [message error]} (rum/react app-state)]
+(rum/defc commands-list [app]
+  [:.jumbotron
+   [:h2 (if (seq (:user-input @app)) "Matching Commands" "All Commands")]
+   [:ul
+    (map #(vector :li (str (:name %)
+                           (when (:alias %) (str " (" (:alias %) ")"))
+                           ": ")
+                  [:a {:href (:url %)} (:url %)])
+         (sort-by :name
+                  (filter
+                   #(or
+                     (> (.indexOf (:url %) (:user-input @app)) -1)
+                     (> (.indexOf (str (:alias %)) (:user-input @app)) -1)
+                     (> (.indexOf (:name %) (:user-input @app)) -1))
+                   (:all-commands @app))))]])
+
+(rum/defc bolt-app < event-loop rum/reactive [app]
+  (let [{:keys [message error]} (rum/react app)]
     [:div
      [:h1 "Welcome to Bolt!"]
      (when error
        [:div {:className "alert alert-danger"} error])
-     (search-form app-state)
+     (search-form app)
      (when message
-       [:div {:className "alert alert-success"} message])]))
+       [:div {:className "alert alert-success"} message])
+     (commands-list app)]))

 ;; Routing

 (defroute "/" []
-  (rum/mount (bolt-app) (.getElementById js/document "app"))
+  (rum/mount (bolt-app app-state) (.getElementById js/document "app"))
   (when (re-find #"start" js/window.location.search)
     (speech/toggle-speech app-state #js {:preventDefault (fn [])})))


Very good algo config. SHIPIT

Very good algo config. SHIPIT

--- src/bru_3/core.clj
+++ src/bru_3/core.clj
@@ -24,9 +24,9 @@
                 :indent 1/3
                 :sharpness 1/9}

-   :distortion-intensity 50
-   :distortion-xresolution 16
-   :distortion-yresolution 8
+   :distortion-intensity 60
+   :distortion-xresolution 10
+   :distortion-yresolution 4

    ;; presentation
    :dot-size 5
@@ -150,7 +150,7 @@
         sw (q/width)
         lw (- lx fx)
         xoff (- (/ (- sw lw) 2) fx)]
-    (q/background 0)
+    (q/background 128)
     (q/fill 255 255 255)
     (q/stroke 255 255 255)
     (q/push-matrix)
@@ -160,8 +160,11 @@
     (when (:draw-frames config)
       (doseq [frame (:frames state)] (draw-frame frame)))
     (when (:draw-wings config)
-      (q/fill 17 110 191)
-      (q/stroke 242 237 228)
+      ;;(q/fill 17 110 191)
+      ;;(q/fill 0)
+      (q/fill 255 0 0)
+      ;;(q/stroke 242 237 228)
+      (q/stroke 255)
       (doseq [verts (:wings state)] (draw-verts verts)))
     (q/pop-matrix)
     (when (:draw-distortion config)


More commentary on assign-position.

More commentary on assign-position.


Switch to maximum load test.

Switch to maximum load test.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -137,10 +137,11 @@
                             (.inc out-cntr)))
                       (not (nil? in-data)) (let [in-fn (get-in-fn pipeline)]
                                              (fn []
-                                               (doseq [i (repeat 2000 0)]
+                                         ;      (doseq [i (repeat 2000 0)]
                                                  (in-fn in-data)
                                                  (.inc in-cntr))
-                                               (sleep 1)))
+                                           )
+                                         ;      (sleep 1)))
                       :default (fn [] (.inc out-cntr))))
           thread-info-fn (create-thread-info-fn)
           stats-fn (fn []
@@ -159,7 +160,7 @@
       (.start in-loop)
       (run-repeat (executor) (fn []
                                (stats-fn)
-                               (thread-info-fn) (println)
+;                               (thread-info-fn) (println)
                                )
                   1000)
       (run-once (executor) (fn [] (System/exit 0)) 120000))))


Make phantomjs the default runner

Make phantomjs the default runner

--- src/leiningen/new/tenzing.clj
+++ src/leiningen/new/tenzing.clj
@@ -107,13 +107,13 @@

 (deftask test []
   (comp (testing)
-        (test-cljs :js-env :rhino
+        (test-cljs :js-env :phantomjs
                    :exit?  true)))

 (deftask auto-test []
   (comp (testing)
         (watch)
-        (test-cljs :js-env :rhino)))")
+        (test-cljs :js-env :phantomjs)))")

 (defn build-tasks [opts]
   (cond-> []


[refactor] Break up `unzip&update-artifact!` function

into three fns. A recursive dependency tree walking function and a pre-fn
which unzips the dependency; and a post-fn which carries out all the
source transformations.

--- src/leiningen/source_deps.clj
+++ src/leiningen/source_deps.clj
@@ -206,18 +206,34 @@
     (clojure.walk/postwalk freq-fn dep-hierarchy)
     @frequency))

+(defn- expand-dep
+  [repositories deps-node]
+  (debug "deps-node: " deps-node)
+  (let [res (if (map? deps-node)
+          (->> (map
+                (fn [[k v]]
+                  (->> (aether/resolve-dependencies :coordinates [k] :repositories repositories)
+                       (aether/dependency-hierarchy [k])))
+                deps-node)
+               (into {}))
+          deps-node)]
+    (debug "res: " res)
+    res))
+
+(defn- expand-dep-hierarchy
+  [repositories dep-hierarchy]
+  (clojure.walk/prewalk
+   (partial expand-dep repositories)
+   (zipmap (keys dep-hierarchy) (repeat nil))))
+
 (defn lookup-opt [opt-key opts]
   (second (drop-while #(not= % opt-key) opts)))

-(defn- unzip&update-artifact! [pname pversion pprefix skip-repackage-java-classes srcdeps src-path dep-hierarchy prefix-exclusions project-source-dirs parent-clj-dirs dep]
-  (let [art-name         (-> dep first name (str/split #"/") last)
-        art-name-cleaned (str/replace art-name #"[\.-_]" "")
-        art-version      (str "v" (-> dep second (str/replace "." "v")))
-        clj-files        (doall (unzip (-> dep meta :file) srcdeps))
-        clj-dirs         (->> (map cljfile->dir clj-files)
-                              (remove str/blank?)
-                              (map (fn [clj-dir] (str srcdeps "/" clj-dir))) set)
-        repl-prefix      (replacement-prefix pprefix src-path art-name-cleaned art-version nil)
+(defn- update-artifact!
+  [{:keys [pname pversion pprefix skip-repackage-java-classes srcdeps prefix-exclusions project-source-dirs]}
+   {:keys [art-name-cleaned art-version clj-files clj-dirs]}
+   {:keys [src-path parent-clj-dirs]}]
+  (let [repl-prefix      (replacement-prefix pprefix src-path art-name-cleaned art-version nil)
         prefixes         (apply dissoc (reduce #(assoc %1 %2 (str (replacement repl-prefix %2 nil))) {} (possible-prefixes clj-files)) prefix-exclusions)
         all-dirs         (->> [(if (str/ends-with? src-path (sym->file-name pprefix))
                                  project-source-dirs
@@ -228,17 +244,8 @@
                                (map fs/file clj-dirs)
                                parent-clj-dirs)
                               vec)]
-    ;; recur on transitive deps, omit clojure and clojurescript
-    (when-let [trans-deps (dep-hierarchy dep)]
-      (debug (format "resolving transitive dependencies for %s:" art-name))
-      (debug trans-deps)
-      (->> trans-deps
-           keys
-           (remove #(#{'org.clojure/clojure 'org.clojure/clojurescript} (first %)))
-           (map (partial unzip&update-artifact! pname pversion pprefix skip-repackage-java-classes srcdeps (fs/file src-path (str/replace (str/join "/" [art-name-cleaned art-version]) "-" "_")) trans-deps prefix-exclusions project-source-dirs (map fs/file clj-dirs)))
-           doall))
-    (info (format "  retrieving %s artifact."  art-name))
-    (debug "    proj-source-dirs" project-source-dirs " clj files" clj-files "clj dirs" clj-dirs " path to dep" (fs/file src-path (str/join "/" [art-name-cleaned art-version])) "parent-clj-dirs: " parent-clj-dirs)
+    (info (format "  munge source files of %s artifact."  art-name-cleaned))
+    (debug "    proj-source-dirs" project-source-dirs " clj files" clj-files "clj dirs" clj-dirs " path to dep" src-path "parent-clj-dirs: " parent-clj-dirs)
     (debug "   modified namespace prefix: " repl-prefix)
     (debug "    src path: " src-path)
     (debug "    all dirs: " all-dirs)
@@ -264,25 +271,32 @@
             ;; remove old file
             (fs/delete old-path)))))))

-(defn- expand-dep
-  [repositories deps-node]
-  (debug "deps-node: " deps-node)
-  (let [res (if (map? deps-node)
-          (->> (map
-                (fn [[k v]]
-                  (->> (aether/resolve-dependencies :coordinates [k] :repositories repositories)
-                       (aether/dependency-hierarchy [k])))
-                deps-node)
-               (into {}))
-          deps-node)]
-    (debug "res: " res)
-    res))
-
-(defn- expand-dep-hierarchy
-  [repositories dep-hierarchy]
-  (clojure.walk/prewalk
-   (partial expand-dep repositories)
-   (zipmap (keys dep-hierarchy) (repeat nil))))
+(defn- unzip-artifact! [{:keys [srcdeps]} {:keys [src-path]} dep]
+  (let [art-name         (-> dep first name (str/split #"/") last)
+        art-name-cleaned (str/replace art-name #"[\.-_]" "")
+        art-version      (str "v" (-> dep second (str/replace "." "v")))
+        clj-files        (doall (unzip (-> dep meta :file) srcdeps))
+        clj-dirs         (->> (map cljfile->dir clj-files)
+                              (remove str/blank?)
+                              (map (fn [clj-dir] (str srcdeps "/" clj-dir)))
+                              set)]
+    (info "unzipping [" art-name-cleaned " [" art-version "]]")
+    (debug (format "resolving transitive dependencies for %s:" art-name))
+    [{:art-name-cleaned art-name-cleaned
+      :art-version      art-version
+      :clj-files        clj-files
+      :clj-dirs         clj-dirs}
+     {:src-path        (fs/file src-path (str/replace (str/join "/" [art-name-cleaned art-version]) "-" "_"))
+      :parent-clj-dirs (map fs/file clj-dirs)}]))
+
+(defn- walk-dep-tree
+  [deps pre-fn post-fn paths ctx]
+  (doseq [[dep subdeps] deps]
+    (when-not (#{'org.clojure/clojure 'org.clojure/clojurescript} (first dep))
+      (let [[pre-result new-paths] (pre-fn ctx paths dep)]
+        (when subdeps
+          (walk-dep-tree subdeps pre-fn post-fn new-paths ctx))
+        (post-fn ctx pre-result paths)))))

 (defn source-deps
   "Dependencies as source: used as if part of the project itself.
@@ -315,11 +329,35 @@
       (do
         (info "working on an unresolved dependency hierarchy")
         (#'ldeps/walk-deps expanded-tree #'ldeps/print-dep)
-        (doall (map (partial unzip&update-artifact! name version pprefix skip-repackage-java-classes srcdeps-relative srcdeps expanded-tree prefix-exclusions project-source-dirs []) (keys expanded-tree))))
+        (walk-dep-tree
+         expanded-tree
+         unzip-artifact!
+         update-artifact!
+         {:src-path        srcdeps
+          :parent-clj-dirs []}
+         {:pname                       name
+          :pversion                    version
+          :pprefix                     pprefix
+          :skip-repackage-java-classes skip-repackage-java-classes
+          :srcdeps                     srcdeps-relative
+          :prefix-exclusions           prefix-exclusions
+          :project-source-dirs         project-source-dirs}))
       (do
         (info "working on a resolved dep hierarchy")
         (#'ldeps/walk-deps dep-hierarchy #'ldeps/print-dep)
-        (doall (map (partial unzip&update-artifact! name version pprefix skip-repackage-java-classes srcdeps-relative srcdeps dep-hierarchy prefix-exclusions project-source-dirs []) (keys ordered-hierarchy)))))
+        (walk-dep-tree
+         ordered-hierarchy
+         unzip-artifact!
+         update-artifact!
+         {:src-path        srcdeps
+          :parent-clj-dirs []}
+         {:pname                       name
+          :pversion                    version
+          :pprefix                     pprefix
+          :skip-repackage-java-classes skip-repackage-java-classes
+          :srcdeps                     srcdeps-relative
+          :prefix-exclusions           prefix-exclusions
+          :project-source-dirs         project-source-dirs})))
     (when-not (or skip-repackage-java-classes (empty? (class-files)))
       (class-deps-jar!)
       (apply-jarjar! name version)


Delete core.clj

Delete core.clj

--- bin/codestarter/core.clj
+++ bin/codestarter/core.clj
@@ -1,142 +0,0 @@
-(ns codestarter.core
-  (:use codestarter.views.common
-        codestarter.csrf
-        compojure.core
-        [compojure.route :as route]
-        [compojure.handler :as handler]
-        korma.core
-        korma.db)
-  (:require (codestarter.views
-              [users :as users]
-              [messages :as messages]
-              [projects :as projects]
-              [updates :as updates]
-              [comments :as comments]
-              [pledges :as pledges]
-              [applications :as applications]
-              [subscriptions :as subscriptions])
-            noir.validation))
-
-(defroutes main-routes
-  (GET "/" request (projects/index request))
-
-  (GET "/oauth2/" request (users/oauth2 request))
-  (GET "/twitter/" request (users/twitter* request))
-
-  (context "/users" request
-           (ANY "/register/" request (users/register request))
-           (ANY "/login/" request (users/login request))
-           (GET "/logout/" request
-                (redirect "/" :request request :session {} :flash "Successfully logged out.")))
-  (context "/users/:id" [id :as request]
-           (GET "/" []
-                (users/show (read-string id) request))
-           (ANY "/edit/" []
-                (users/edit (read-string id) request))
-           (ANY "/edit-password/" []
-                (users/edit-password (read-string id) request))
-           (context "/messages" []
-                    (GET "/" []
-                         (messages/index (read-string id) request))
-                    (POST "/" []
-                          (messages/create (read-string id) nil request))
-                    (ANY "/create/" []
-                         (messages/create (read-string id) nil request))
-                    (GET "/:message-id/" [message-id]
-                         (messages/index (read-string id) request))
-                    (GET "/:message-id/create/" [id message-id :as request]
-                         (messages/index (read-string id) request))
-                    (POST "/:message-id/create/" [id message-id :as request]
-                          (messages/create (read-string id) (read-string message-id) request)))
-           (GET "/notifications/" []
-                (users/notifications* (read-string id) request))
-           (GET "/projects/" []
-                (users/projects* (read-string id) request))
-           (ANY "/subscriptions/" []
-                (users/subscriptions* (read-string id) request))
-           (GET "/send-confirmation/" []
-                (users/send-confirmation* (read-string id) request))
-           (GET "/confirm/:key/" [key]
-                (users/confirm (read-string id) key request)))
-  (context "/projects" request
-           (ANY "/create/" []
-                (projects/create request)))
-  (context "/projects/:id" [id :as request]
-           (GET "/" []
-                (projects/show (read-string id) request))
-           (ANY "/edit/" []
-                (projects/edit (read-string id) request))
-           (GET "/pledges/" []
-                (pledges/index (read-string id) request))
-           (ANY "/pledges/create/" []
-                (pledges/create (read-string id) request))
-           (ANY "/pledges/:pledge-id/edit/" [id pledge-id :as request]
-                (pledges/edit (read-string id) (read-string pledge-id) request))
-           (ANY "/pledges/:pledge-id/delete/" [id pledge-id :as request]
-                 (pledges/delete* (read-string id) (read-string pledge-id) request))
-           (GET "/applications/" []
-                (applications/index (read-string id) request))
-           (ANY "/applications/create/" []
-                (applications/create (read-string id) request))
-           (ANY "/applications/:application-id/delete/" [id application-id :as request]
-                 (applications/delete* (read-string id) (read-string application-id) request))
-           (ANY "/applications/:application-id/select/" [id application-id :as request]
-                 (applications/select* (read-string id) (read-string application-id) request))
-           (ANY "/:number/edit/" [number]
-                (projects/edit (read-string id) (read-string number) request))
-           (context "/comments" []
-                    (GET "/" []
-                         (comments/index (read-string id) request))
-                    (POST "/" []
-                          (comments/create (read-string id) nil nil :projects request))
-                    (GET "/:comment-id/" [comment-id]
-                         (comments/index (read-string id) request))
-                    (GET "/:comment-id/create/" [id comment-id :as request]
-                         (comments/index (read-string id) request))
-                    (POST "/:comment-id/create/" [id comment-id :as request]
-                          (comments/create (read-string id) nil (read-string comment-id)
-                                           :projects
-                                           request)))
-           (context "/updates" []
-                    (GET "/" []
-                         (updates/index (read-string id) request))
-                    (ANY "/create/" []
-                         (updates/create (read-string id) request))
-                    (GET "/:number/" [number]
-                         (updates/show (read-string id) (read-string number) request)))
-           (context "/updates/:number/comments" [number]
-                    (GET "/" [number]
-                         (updates/show (read-string id) (read-string number) request))
-                    (POST "/" []
-                          (comments/create (read-string id) (read-string number) nil
-                                           :updates
-                                           request))
-                    (GET "/:comment-id/" [comment-id]
-                         (updates/show (read-string id) (read-string number) request))
-                    (GET "/:comment-id/create/" [id number comment-id :as request]
-                         (updates/show (read-string id) (read-string number) request))
-                    (POST "/:comment-id/create/" [id number comment-id :as request]
-                          (comments/create (read-string id) (read-string number) (read-string comment-id)
-                                           :updates
-                                           request)))
-           (context "/subscriptions" []
-                    (ANY "/" []
-                         (subscriptions/edit (read-string id) request)))
-           (GET "/rss/" []
-                  (subscriptions/rss (read-string id) request)))
-  (route/resources "/"))
-
-(def app
-  (->
-    main-routes
-    (wrap-anti-forgery)
-    (#(fn [request]
-        (binding [*user* (-> request :session :user)]
-          (% request))))
-    (#(fn [request]
-        (if-let [errors (-> request :session :errors)]
-          (binding [noir.validation/*errors* errors]
-            (assoc (% request) :session (dissoc (request :session) :errors)))
-          (% request))))
-    (noir.validation/wrap-noir-validation)
-    (handler/site)))


Fix missing declaration of route->adjust-window-offsets

--- src/vignette/http/routes.clj
+++ src/vignette/http/routes.clj
@@ -86,6 +86,7 @@
          handle-original
          get-image-params
          route->offset
+         route->adjust-window-offsets
          route->thumbnail-map
          route->thumbnail-auto-height-map
          route->options


72 scroll up/down/left/right functions added.

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -1212,6 +1212,41 @@
   (let [y-max (js-execute driver "return document.body.scrollHeight;")
         {:keys [x y]} (get-scroll driver)]
     (scroll driver x y-max)))
+
+(def ^{:doc "Default scroll offset in pixels."}
+  scroll-offset 100)
+
+(defn scroll-up
+  "Scrolls the page up by specific number of pixels.
+  The `scroll-offset` constant is used when not passed."
+  ([driver offset]
+   (scroll-by driver 0 (- offset)))
+  ([driver]
+   (scroll-up driver scroll-offset)))
+
+(defn scroll-down
+  "Scrolls the page down by specific number of pixels.
+  The `scroll-offset` constant is used when not passed."
+  ([driver offset]
+   (scroll-by driver 0 offset))
+  ([driver]
+   (scroll-down driver scroll-offset)))
+
+(defn scroll-left
+  "Scrolls the page left by specific number of pixels.
+  The `scroll-offset` constant is used when not passed."
+  ([driver offset]
+   (scroll-by driver offset 0))
+  ([driver]
+   (scroll-left driver scroll-offset)))
+
+(defn scroll-right
+  "Scrolls the page right by specific number of pixels.
+  The `scroll-offset` constant is used when not passed."
+  ([driver offset]
+   (scroll-by driver (- offset) 0))
+  ([driver]
+   (scroll-right driver scroll-offset)))

 ;;
 ;; logs


Adding function to build a single software package by name

--- src/fatty/core.clj
+++ src/fatty/core.clj
@@ -76,6 +76,13 @@
     (clean *fatty-build-dir* soft)
     (prep *fatty-build-dir* *fatty-source-dir* soft)
     (run-steps *fatty-build-dir* soft)))
+
+(defn build-software-by-name
+  "Build a software package by name, rather than by clojure form"
+  [software-name]
+  (let [mapper #(assoc %1 (%2 :name) %2)
+        software-descs (reduce mapper  {}  (load-forms *fatty-software-dir*))]
+    (build-software (software-descs software-name))))

 (defn build-tarball
   "Builds a tarball of the entire mess"


Add initial clojure api.

Add initial clojure api.

--- src/fault/core.clj
+++ src/fault/core.clj
@@ -1,2 +1,10 @@
-(ns fault.core)
+(ns fault.core
+  (:import (fault.java ServiceExecutor ResilientAction)))

+
+(defn service-executor [num-of-threads]
+  (ServiceExecutor. num-of-threads))
+
+(defn resilient-action [f]
+  (reify ResilientAction
+    (run [_] (f))))


CMR-4603: Added more integration tests.

CMR-4603: Added more integration tests.

--- system-int-test/test/cmr/system_int_test/ingest/bulk_update/bulk_update_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/bulk_update/bulk_update_test.clj
@@ -368,6 +368,48 @@
                     :Instruments [{:ShortName "NSIDC"}]}]
                   (:Platforms (:umm concept)))))))))

+(deftest nil-platform-long-name-bulk-update
+    (let [concept-ids (ingest-collection-in-umm-json-format platforms-instruments-umm)
+          _ (index/wait-until-indexed)]
+      (testing "nil platform long name find and update"
+        (let [bulk-update-body {:concept-ids concept-ids
+                                :name "TEST NAME"
+                                :update-type "FIND_AND_UPDATE"
+                                :update-field "PLATFORMS"
+                                :find-value {:ShortName "a340-600-1"}
+                                :update-value {:ShortName "NSIDC"
+                                               :LongName nil}}
+              task-id (:task-id (ingest/bulk-update-collections "PROV1" bulk-update-body))]
+          (index/wait-until-indexed)
+          (let [collection-response (ingest/bulk-update-task-status "PROV1" task-id)]
+            (is (= "COMPLETE" (:task-status collection-response))))
+
+          ;; Check that each concept was updated
+          (doseq [concept-id concept-ids
+                  :let [concept (-> (search/find-concepts-umm-json :collection
+                                                                   {:concept-id concept-id})
+                                    :results
+                                    :items
+                                    first)]]
+           (is (= 2
+                  (:revision-id (:meta concept))))
+           (is (= [{:ShortName "NSIDC"
+                    :Type "Aircraft"}
+                   {:ShortName "a340-600-2"
+                    :LongName "airbus a340-600"
+                    :Type "Aircraft"
+                    :Instruments [{:ShortName "atm"
+                                   :LongName "airborne topographic mapper"
+                                   :Technique "testing"
+                                   :NumberOfInstruments 0
+                                   :OperationalModes ["mode1" "mode2"]}]}
+                   {:ShortName "a340-600-3"
+                    :LongName "airbus a340-600"
+                    :Type "Aircraft"
+                    :Instruments [{:ShortName "atm"
+                                   :LongName "airborne topographic mapper"}]}]
+                  (:Platforms (:umm concept)))))))))
+
 (deftest data-center-home-page-url-removal
     (let [concept-ids (ingest-collection-in-umm-json-format data-centers-umm-with-home-page-url)
           _ (index/wait-until-indexed)]


added all countries to tilesets.clj, commented out previous countries


Added Rwanda to tileset

Added Rwanda to tileset


Added game-state-emitter process

Added game-state-emitter process

--- src/clj/funstructor/processes.clj
+++ src/clj/funstructor/processes.clj
@@ -94,14 +94,14 @@
   (merge (make-game-update-data game-map)
          (make-player-update-data game-map player-id)))

-(defn send-game-updates [game-map p1-id p1-ch p2-id p2-ch]
+(defn send-game-updates [game-map p1-info p2-info]
   (a/go
     (let [p1-game-update {:type :game-update
-                          :data (make-update-data game-map p1-id)}
+                          :data (make-update-data game-map (:id p1-info))}
           p2-game-update {:type :game-update
-                          :data (make-update-data game-map p2-id)}]
-      (c/write-cmd-to-ch p1-ch p1-game-update)
-      (c/write-cmd-to-ch p2-ch p2-game-update))))
+                          :data (make-update-data game-map (:id p2-info))}]
+      (c/write-cmd-to-ch (:br-ch p1-info) p1-game-update)
+      (c/write-cmd-to-ch (:br-ch p2-info) p2-game-update))))

 (defmulti apply-cmd (fn [game-map player-id cmd] (:type cmd)))
@@ -122,83 +122,87 @@
 (defmethod cmd-resets-timer? :action [_] false)
 (defmethod cmd-resets-timer? :end-turn [_] true)

-(defn game-update-process [game-id initial-game-map p1-id p1-ch p2-id p2-ch]
+
+
+(defn- handle-command [sender-id cmd game-map timer]
+  (if (= (f/get-current-turn game-map) sender-id)
+    (let [new-game-map (apply-cmd game-map sender-id cmd)]
+      [new-game-map (if (cmd-resets-timer? cmd)
+                      (a/timeout turn-time-delay)
+                      timer)])
+    [game-map timer]))
+
+(defn game-update-process [game-id game-state-ch initial-game-map p1-info p2-info]
   (t/info "Starting game update process for game" game-id)
-  (a/go-loop [game-map initial-game-map
-              timer (a/timeout turn-time-delay)]
-    (let [current-turn (f/get-current-turn game-map)
-          [value ch] (c/read-cmd-from-chs [p1-ch p2-ch]
-                                          [:action :end-turn]
-                                          :timeout-ch timer)]
-
-      (t/info "Game update process received message: " value)
-
-      (if (and (not (= ch timer))
-               (nil? value))
-        (let [new-game-map (f/player-win game-map
-                                         (if (= ch p1-ch)
-                                           p2-id
-                                           p1-id))]
-          (send-game-updates new-game-map p1-id p1-ch p2-id p2-ch))
-
-        (condp = ch
-
-          p1-ch
-          (if (= current-turn p1-id)
-            (let [new-game-map (apply-cmd game-map p1-id value)]
-              (a/<! (send-game-updates new-game-map p1-id p1-ch p2-id p2-ch))
-              (recur new-game-map (if (cmd-resets-timer? value)
-                                    (a/timeout turn-time-delay)
-                                    timer)))
-            (recur game-map timer))
-
-          p2-ch
-          (if (= current-turn p2-id)
-            (let [new-game-map (apply-cmd game-map p2-id value)]
-              (a/<! (send-game-updates new-game-map p1-id p1-ch p2-id p2-ch))
-              (recur new-game-map (if (cmd-resets-timer? value)
-                                    (a/timeout turn-time-delay)
-                                    timer)))
-            (recur game-map timer))
-
-          timer
-          (let [new-game-map (apply-cmd
-                              game-map
-                              current-turn
-                              {:type :end-turn
-                               :data {:game-id game-id}})]
-            (t/info "Turn time of player" current-turn " has elapsed. Forcing next turn ...")
-            (a/<! (send-game-updates new-game-map p1-id p1-ch p2-id p2-ch))
-            (recur new-game-map (a/timeout turn-time-delay))))))))
-
-
-(defn game-chat-process [game-id p1-id p1-ch p1-name p2-id p2-ch p2-name]
+  (let [{p1-id :id p1-ch :br-ch} p1-info
+        {p2-id :id p2-ch :br-ch} p2-info]
+    (a/go-loop [game-map initial-game-map
+                timer (a/timeout turn-time-delay)]
+      (let [[value ch] (c/read-cmd-from-chs [p1-ch p2-ch]
+                                            [:action :end-turn]
+                                            :timeout-ch timer)]
+
+        (t/info "Game update process received message: " value)
+
+        (if (and (not (= ch timer))
+                 (nil? value))
+          (let [new-game-map (f/player-win game-map
+                                           (if (= ch p1-ch)
+                                             p2-id
+                                             p1-id))]
+            (a/>! game-state-ch new-game-map))
+
+          (condp = ch
+
+            p1-ch
+            (let [[new-game-map timer] (handle-command p1-id value game-map timer)]
+              (a/>! game-state-ch new-game-map)
+              (recur new-game-map timer))
+
+            p2-ch
+            (let [[new-game-map timer] (handle-command p2-id value game-map timer)]
+              (a/>! game-state-ch new-game-map)
+              (recur new-game-map timer))
+
+            timer
+            (let [[new-game-map timer] (handle-command (f/get-current-turn game-map)
+                                                       {:type :end-turn
+                                                        :data {:game-id game-id}}
+                                                       timer)]
+              (t/info "Turn time of player" (f/get-current-turn game-map) "has elapsed. Forcing next turn ...")
+              (a/>! game-state-ch new-game-map)
+              (recur new-game-map timer))))))))
+
+
+(defn game-chat-process [game-id p1-info p2-info]
   (t/info "Starting game chat process for game " game-id)
-  (a/go-loop []
-    (let [[value ch] (c/read-cmd-from-chs [p1-ch p2-ch]
-                                          [:chat-message])]
-      (t/info "Game chat process received message: " value)
-      (when-not (nil? value)
-        (condp = ch
-
-          p1-ch
-          (do (c/write-cmd-to-chs
-               [p1-ch p2-ch]
-               {:type :chat-message-response
-                :data {:player-id p1-name
-                       :message (get-in value [:data :message])
-                       }}
-               true)
-              (recur))
-
-          p2-ch
-          (do (c/write-cmd-to-chs
-               [p1-ch p2-ch]
-               {:type :chat-message-response
-                :data {:player-id p2-name
-                       :message (get-in value [:data :message])}}
-               true)
-              (recur)))))))
+  (let [{p1-name :name p1-ch :br-ch} p1-info
+        {p2-name :name p2-ch :br-ch} p2-info]
+    (a/go-loop []
+      (let [[value ch] (c/read-cmd-from-chs [p1-ch p2-ch]
+                                            [:chat-message])]
+        (t/info "Game chat process received message: " value)
+        (when-not (nil? value)
+          (condp = ch
+
+            p1-ch
+            (do (c/write-cmd-to-chs
+                 [p1-ch p2-ch]
+                 {:type :chat-message-response
+                  :data {:player-id p1-name
+                         :message (get-in value [:data :message])
+                         }}
+                 true)
+                (recur))
+
+            p2-ch
+            (do (c/write-cmd-to-chs
+                 [p1-ch p2-ch]
+                 {:type :chat-message-response
+                  :data {:player-id p2-name
+                         :message (get-in value [:data :message])}}
+                 true)
+                (recur))))))))

 (defn- pre-game-exchange [game-id game-map p1-info p2-info]
   (t/info "Initiating pre game exchange for game" game-id)
@@ -224,37 +228,36 @@
       ;; Rework this in future ... with timeouts possibly

       (c/read-cmd-by-type (:br-ch p1-info) :start-game-ok)
-      (c/read-cmd-by-type (:br-ch p2-info) :start-game-ok)
-
-      (send-game-updates game-map
-                         (:id p1-info)
-                         (:br-ch p1-info)
-                         (:id p2-info)
-                         (:br-ch p2-info)))))
-
-(defn game-process [p1 p2]
+      (c/read-cmd-by-type (:br-ch p2-info) :start-game-ok))))
+
+(defn game-state-emitter-process [game-id game-state-ch p1-info p2-info]
+  (a/go-loop [game-state (a/<! game-state-ch)]
+    (when game-state
+      (send-game-updates game-state p1-info p2-info)
+      (recur (a/<! game-state-ch)))))
+
+(defn game-process [p1-info p2-info]
   (let [game-id (u/next-id!)
-        player1-id (:id p1)
-        player1-chan (:br-ch p1)
-        player1-name (:name p1)
-        player2-id (:id p2)
-        player2-chan (:br-ch p2)
-        player2-name (:name p2)
-
-        initial-game-map (f/init-game (f/make-game player1-id player2-id player1-name player2-name))]
-    (t/info "Starting game process for players" player1-id  player2-id "and game" game-id)
+        game-state-ch (a/chan) ;; TODO: Consider using sliding buffer for this chan
+
+        initial-game-map (f/init-game (f/make-game
+                                       (:id p1-info)
+                                       (:id p2-info)
+                                       (:name p1-info)
+                                       (:name p2-info)))]
+
+
+    (t/info "Starting game process for players" (:id p1-info) (:id p2-info) "and game" game-id)
     (a/go
-      (a/<! (pre-game-exchange game-id initial-game-map p1 p2))
+      (game-state-emitter-process game-id game-state-ch p1-info p2-info)
+      (a/<! (pre-game-exchange game-id initial-game-map p1-info p2-info))
+      (a/>! game-state-ch initial-game-map)
       (game-update-process game-id
+                           game-state-ch
                            initial-game-map
-                           player1-id
-                           player1-chan
-                           player2-id
-                           player2-chan)
+                           p1-info
+                           p2-info)
       (game-chat-process game-id
-                         player1-id
-                         player1-chan
-                         player1-name
-                         player2-id
-                         player2-chan
-                         player2-name))))
+                         p1-info
+                         p2-info))))
+


add test for Chronos Protocol

add test for Chronos Protocol

--- src/clj/test/cards-identities.clj
+++ src/clj/test/cards-identities.clj
@@ -90,6 +90,35 @@
     (play-from-hand state :corp "Hedge Fund")
     (is (= 13 (:credit (get-corp))) "Has 13 credits")
     (is (= 13 (core/hand-size state :corp)) "Max hand size is 13")))
+
+(deftest chronos-protocol
+  "Chronos Protocol - Choose Runner discard for first net damage of a turn"
+  (do-game
+    (new-game
+      (make-deck "Chronos Protocol: Selective Mind-mapping" [(qty "Pup" 1) (qty "Neural EMP" 2)])
+      (default-runner [(qty "Imp" 3)]))
+    (play-from-hand state :corp "Pup" "HQ")
+    (take-credits state :corp)
+    (run-on state :hq)
+    (let [pup (get-ice state :hq 0)]
+      (core/rez state :corp pup)
+      (card-ability state :corp pup 0)
+      (prompt-choice :corp "Yes")
+      (let [imp (find-card "Imp" (:hand (get-runner)))]
+        (prompt-choice :corp imp)
+        (is (= 1 (count (:discard (get-runner)))))
+        (card-ability state :corp pup 0)
+        (is (empty? (:prompt (get-corp))) "No choice on second net damage")
+        (is (= 2 (count (:discard (get-runner)))))
+        (run-jack-out state)
+        (take-credits state :runner)
+        (core/move state :runner (find-card "Imp" (:discard (get-runner))) :hand)
+        (play-from-hand state :corp "Neural EMP")
+        (prompt-choice :corp "No")
+        (is (= 2 (count (:discard (get-runner)))) "Damage dealt after declining ability")
+        (play-from-hand state :corp "Neural EMP")
+        (is (empty? (:prompt (get-corp))) "No choice after declining on first damage")
+        (is (= 3 (count (:discard (get-runner)))))))))

 (deftest edward-kim
   "Edward Kim - Trash first operation accessed each turn, but not if first one was in Archives"


Fix logout error message pre-emptively showing up

--- src/cljs/elevent_client/core.cljs
+++ src/cljs/elevent_client/core.cljs
@@ -315,7 +315,7 @@
                              (reset! messages {})
                              (add-message! :positive "Sign in succeeded")
                              (js/location.replace (events-route)))
-          :error-handler   (add-message! :negative "Sign in failed")})))
+          :error-handler   #(add-message! :negative "Sign in failed")})))

 (defn sign-out! []
   (swap! session dissoc :token :user :stripe-token)
@@ -365,7 +365,16 @@
    (let [in  (or in  identity)
          out (or out identity)]
      (r/create-class
-       {:component-did-update
+       {:component-did-mount
+        (fn [this]
+          (when (= type :select)
+            (-> this
+                r/dom-node
+                js/jQuery
+                (.dropdown (clj->js {:onChange #(when % (reset! state
+                                                                (out %)))})))))
+
+        :component-did-update
         (fn [this]
           (when (= type :select)
             (-> this


Fix user editing

Fix user editing

--- src/cljs/salava/user/ui/edit.cljs
+++ src/cljs/salava/user/ui/edit.cljs
@@ -24,6 +24,7 @@
     (ajax/POST
       (path-for "/obpv1/user/edit")
       {:params  (-> params
+                    (dissoc :private)
                     (dissoc :password?)
                     (dissoc :role)
                     (assoc :current_password current-password


more line graph work

more line graph work

--- src/cljs/ta_crash/line_graph.cljs
+++ src/cljs/ta_crash/line_graph.cljs
@@ -27,7 +27,7 @@
     :bicycle "Bicycle Involved"
     :lost-consciousness "Lost Consciousness Contributing Factor"))

-(defn get-line-graph-data
+(defn get-line-graph-data
   [type data]
   ;(println "get-line-graph-data: " (count data))
   {:title (get-graph-title type)
@@ -38,7 +38,7 @@
             :identifier (:identifier x)
             :val (get-data-type type (:totals x))}) data)})

-(defn set-graph
+(defn set-graph
   [graph-data]
   (println (count (clj->js (map #(js/Date. (:year %) (:month %)) graph-data))))
   (let [count-data (count graph-data)
@@ -56,6 +56,12 @@
         time-scale (-> (.scale (.-time js/d3))
                        (.domain #js [(js/Date. (:year (first graph-data)) 0), (js/Date. (:year (first graph-data)) 11)])
                        (.range #js [0, width]))
+        x-pos (fn [d] (time-scale (.-month d)))
+        y-pos (fn [d] (total-scale (.-val d)))
+        line-segment (-> (.line (.-svg js/d3))
+                         (.x (fn [d] (x-pos d)))
+                         (.y (fn [d] (y-pos d)))
+                         (.interpolate "linear"))
         y-axis (graph/create-axis total-scale :right width tick-padding graph/number-formatter y-tick-count)
         x-axis (graph/create-axis time-scale :top height tick-padding graph/month-formatter x-tick-count)
         x-axis-group (-> (.append line-group "g")
@@ -66,8 +72,7 @@
                          (.attr "x" 0)
                          (.attr "y" 12)
                          (.attr "dx" "-1.5em")
-                         (.style "text-anchor" "start")
-                         )
+                         (.style "text-anchor" "start"))
         y-axis-group (-> (.append line-group "g")
                          (.attr "transform" (str "translate(0, -25)"))
                          (.attr "class" "y axis")
@@ -77,16 +82,13 @@
                          (.attr "y" 0)
                          (.attr "dy" ".25em")
                          (.style "text-anchor" "end"))
-        lines (-> (.selectAll line-group "rect.bar")
-                 (.data (clj->js graph-data)))
+        lines (-> (.selectAll line-group "path.crash-month-line")
+                  (.data (clj->js graph-data)))
         enter (.enter lines)]
     (println "set-graph:" graph-data)
-    ;(-> (.append enter "svg:rect")
-    ;    (.attr "x" 0)
-    ;    (.attr "y" #(* bar-height %2))
-    ;    (.attr "height" (- bar-height bar-padding))
-    ;    (.attr "width" #(total-scale (.-val %)))
-    ;    (.attr "class" #(.-type %)))
+    (-> (.append enter "svg:path")
+        (.attr "d" line-segment)
+        (.attr "class" #(.-year %)))
     ))

 (defn line-graph-view
@@ -101,4 +103,4 @@
       ;(println "line-graph-data: " data)
       (dom/div nil
         (dom/h2 #js {:className "graph-title"} title)
-        (dom/div #js {:className "line-graph-modal"})))))+        (dom/div #js {:className "line-graph-modal"})))))


Pass context to compliment

Pass context to compliment

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -1,12 +1,15 @@
 (ns nightcode.editors
   (:require [clojure.java.io :as io]
+            [clojure.zip :as zip]
             [compliment.core :as compliment]
             [flatland.ordered.map :as flatland]
             [nightcode.lein :as lein]
             [nightcode.shortcuts :as shortcuts]
             [nightcode.ui :as ui]
             [nightcode.utils :as utils]
-            [paredit-widget.core :as paredit]
+            [paredit.loc-utils :as loc-utils]
+            [paredit.parser :as parser]
+            [paredit-widget.core :as pw]
             [seesaw.color :as color]
             [seesaw.core :as s])
   (:import [com.camick TextPrompt]
@@ -241,6 +244,22 @@
     (setMarginLinePosition [size]
       (proxy-super setMarginLinePosition size))))

+(defn get-context
+  [prefix]
+  (when-let [editor (get-selected-editor)]
+    (let [caretpos (.getCaretPosition editor)
+          all-text (.getText editor)
+          first-str (subs all-text 0 (- caretpos (count prefix)))
+          second-str (subs all-text caretpos)]
+      (-> (str first-str "__prefix__" second-str)
+          parser/parse
+          loc-utils/parsed-root-loc
+          (loc-utils/loc-for-offset caretpos)
+          zip/up
+          first
+          loc-utils/node-text
+          read-string))))
+
 (defn get-completion-provider
   [extension]
   (cond
@@ -249,7 +268,7 @@
     (proxy [DefaultCompletionProvider] []
       (getCompletions [comp]
         (if-let [prefix (.getAlreadyEnteredText this comp)]
-          (for [symbol-str (compliment/completions prefix nil)]
+          (for [symbol-str (compliment/completions prefix (get-context prefix))]
             (->> (compliment/documentation symbol-str)
                  (BasicCompletion. this symbol-str nil)))
           '()))
@@ -277,7 +296,7 @@
           ; get the functions for toggling paredit and performing completion
           is-clojure? (contains? clojure-exts extension)
           toggle-paredit-fn (when is-clojure?
-                              (paredit/get-toggle-fn text-area))
+                              (pw/get-toggle-fn text-area))
           completer (get-completer text-area extension)
           do-completion-fn (fn [_]
                              (s/request-focus! text-area)


Render snippets in doc search results

Render snippets in doc search results

Depends on https://github.com/circleci/circle/pull/4827

--- src-cljs/frontend/components/documentation.cljs
+++ src-cljs/frontend/components/documentation.cljs
@@ -99,7 +99,7 @@
                   (for [result query-results]
                     [:li
                      [:a {:href (:url result)} (:title result)]
-;                     [:p (:snippet_text result)]
+                     [:p {:dangerouslySetInnerHTML {:__html  (:snippet_text result)}}]
                      ])]]
                 query
                 [:p "No articles found matching \"" [:strong query] "\""]


Logo links to "home"

Logo links to "home"

--- src-cljs/frontend/components/pieces/topbar.cljs
+++ src-cljs/frontend/components/pieces/topbar.cljs
@@ -21,7 +21,7 @@
       [:div.top-bar
        [:div.bar
         [:div.header-nav.left
-         [:a.logo
+         [:a.logo {:href "/"}
           [:div.logomark
            (common/ico :logo)]]]
         [:div.header-nav.right


read and save wiki file for adding PMCIDs

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

--- sandbox/refs/src/refs/core.clj
+++ sandbox/refs/src/refs/core.clj
@@ -2,6 +2,9 @@
   (use [clojure.xml :as xml]))

 (def url-stub "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?")
+
+(defn read-paras [file]
+  (.split (slurp file) "\n\n"))

 (defn get-xml [doi]
   (clojure.xml/parse (str url-stub "term=" doi)))
@@ -62,5 +65,8 @@
             "}}"))))
     para))

+(defn write-paras [paras file]
+  (spit file (apply str (interpose "\n\n" paras))))
+
 (defn doi-to-pmcid [doi]
   (-> doi doi-to-pmid pmid-to-pmcid))


removed unused code

removed unused code

--- luminus/hello/src/hello/repl.clj
+++ luminus/hello/src/hello/repl.clj
@@ -1,34 +0,0 @@
-(ns hello.repl
-  (:use hello.handler
-        ring.server.standalone
-        [ring.middleware file-info file]))
-
-(defonce server (atom nil))
-
-(defn get-handler []
-  ;; #'app expands to (var app) so that when we reload our code,
-  ;; the server is forced to re-resolve the symbol in the var
-  ;; rather than having its own copy. When the root binding
-  ;; changes, the server picks it up without having to restart.
-  (-> #'app
-    ; Makes static assets in $PROJECT_DIR/resources/public/ available.
-    (wrap-file "resources")
-    ; Content-Type, Content-Length, and Last Modified headers for files in body
-    (wrap-file-info)))
-
-(defn start-server
-  "used for starting the server in development mode from REPL"
-  [& [port]]
-  (let [port (if port (Integer/parseInt port) 8080)]
-    (reset! server
-            (serve (get-handler)
-                   {:port port
-                    :init init
-                    :auto-reload? true
-                    :destroy destroy
-                    :join true}))
-    (println (str "You can view the site at http://localhost:" port))))
-
-(defn stop-server []
-  (.stop @server)
-  (reset! server nil))


Get rid of more bogus spying

Get rid of more bogus spying

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -30,7 +30,7 @@
         blob (<!! (retrieve store index))
         encoded-plan (crypto/decrypt scheme cap-key blob)
         plan (spy (nippy/thaw encoded-plan))
-        sub-results (spy (execute plan))]
+        sub-results (execute plan)]
     (async/into {} sub-results)))

 (defn revoke-cap


fix weird bug

fix weird bug

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

--- plugins/SlideExplorer2/src/slide_explorer/affine.clj
+++ plugins/SlideExplorer2/src/slide_explorer/affine.clj
@@ -4,19 +4,19 @@
     (java.awt.geom AffineTransform Point2D$Double)))

 (defprotocol AffineTransformable
-  (transform [object affine] "Apply affine transform to object.")
-  (inverse-transform [object affine] "Apply inverse transform to object."))
-
+  (transform [this aff] "Apply affine transform to object.")
+  (inverse-transform [this aff] "Apply inverse transform to object."))
+
 (extend-protocol AffineTransformable
   Point2D$Double
-    (transform [object affine] (.transform affine object nil))
-    (inverse-transform [object affine] (.inverseTransform affine object nil))
+    (transform [object aff] (.transform aff object nil))
+    (inverse-transform [object aff] (.inverseTransform aff object nil))
   Point
-    (transform [object affine] (transform (Point2D$Double. (.x object) (.y object)) affine))
-    (inverse-transform [object affine] (inverse-transform (Point2D$Double. (.x object) (.y object)) affine))
+    (transform [object aff] (transform (Point2D$Double. (.x object) (.y object)) aff))
+    (inverse-transform [object aff] (inverse-transform (Point2D$Double. (.x object) (.y object)) aff))
   Shape
-    (transform [object affine] (.createTransformedShape affine object))
-    (inverse-transform [object affine] (transform object (.createInverse affine))))
+    (transform [object aff] (.createTransformedShape aff object))
+    (inverse-transform [object aff] (transform object (.createInverse aff))))

 (defn point-to-vector [point]
   [(.x point) (.y point)])
@@ -25,11 +25,9 @@
   "Produces an affine transform which is same as the original except that
    the offsets have been modifed such that source-point maps to the
    origin (0,0) in the destination coordinate space."
-  [^AffineTransform affine ^Point2D$Double source-point]
-  (let [[x y] (point-to-vector (transform source-point affine))
-        new-affine (.clone affine)]
+  [^AffineTransform aff ^Point2D$Double source-point]
+  (let [[x y] (point-to-vector (transform source-point aff))
+        new-affine (.clone aff)]
     (doto new-affine
       (.preConcatenate (AffineTransform/getTranslateInstance (- x) (- y))))))

-
-


allow with-context

allow with-context

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -504,12 +504,15 @@
   arguments and returns a value inside the given monadic context, an initial
   value, and a collection of values, perform a left-associative fold."
   ([f z xs]
-   {:pre [(seq xs)]}
-   (let [[h & t] xs]
+   {:pre [(or (seq xs) (get-current-context))]}
+   (if-let [[h & t] (seq xs)]
      (mlet [z' (f z h)]
        (if (empty? t)
          (return z')
-         (foldm f z' t)))))
+         (foldm f z' t)))
+     (or (some-> (get-current-context) (return z))
+         ;; TODO: write better exception message
+         (throw (Exception. "missing context")))))
   ([ctx f z xs]
    (if (empty? xs)
      (return ctx z)


Display ch near the first-taker-actx.

Display ch near the first-taker-actx.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -118,26 +118,34 @@

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

-(defn vis-html-actx [vis actx]
+(defn vis-html-actx [vis actx actx-ch-ch-infos]
   (if actx
-    (let [d (get-in vis [:actxs actx])
-          children (:children d)
-          wait-chs (:wait-chs d)]
+    (let [chs (:chs vis)
+          actx-info (get-in vis [:actxs actx])
+          children (:children actx-info)
+          wait-chs (:wait-chs actx-info)]
       ["
" (last actx)
        (if (not-empty wait-chs)
          [" -- waiting: ("
           (map (fn [kv]
                  (let [[ch wait-kind] kv]
-                   [(:id (get (:chs vis) ch)) wait-kind ", "]))
+                   [(:id (get chs ch)) wait-kind ", "]))
                wait-chs)
           ")"]
          [])
        (if (not-empty children)
          ["
"
-          (map (fn [kv] ["
" (vis-html-actx vis (first kv)) "
"])
+          (map (fn [child-actx-bool] ["
"
+                                      (vis-html-actx vis (first child-actx-bool)
+                                                     actx-ch-ch-infos)
+                                      "
"])
                children)
           "
"]
          [])
+       "
"
+       (map (fn [ch-ch-info] ["
" (:id (second ch-ch-info)) "
"])
+            (get actx-ch-ch-infos actx))
+       "
"
        "
"])
     "no actx"))

@@ -193,7 +201,9 @@
         (vis-event-handler vis actx args)
         (set-el-innerHTML "vis-html"
                           (apply str
-                                 (flatten [(vis-html-actx @vis @root-actx)
+                                 (flatten [(vis-html-actx @vis @root-actx
+                                                          (group-by #(:first-taker-actx (second %))
+                                                                    (:chs @vis)))
                                            "
"
                                            (vis-html-chs @vis)])))
         (set-el-innerHTML "vis"


Update github issue form.

Update github issue form.

--- src/cljs/hatnik/web/client/form/add_action.cljs
+++ src/cljs/hatnik/web/client/form/add_action.cljs
@@ -88,38 +88,42 @@
                                            :value (:template data)
                                            :onChange #((:template-handler data) (.. % -target -value))}))))))

-(defn github-issue-on-change [user repo timer form-handler form-status-handler error-handler]
+(defn github-issue-on-change [gh-repo timer form-handler form-status-handler error-handler]
   (js/clearTimeout timer)

-  (form-handler
-   (if (or (nil? user)
-           (nil? repo)
-           (= "" user)
-           (= "" repo))
-     (do
-       (form-status-handler "has-warning")
-       nil)
-     (js/setTimeout
-      (fn []
-        (action/get-github-repos
-         user
-         (fn [reply]
-           (let [rest (js->clj reply)
-                 result (->> rest
-                             (map #(get % "name"))
-                             (filter #(= % repo)))]
-             (if (first result)
-               (form-status-handler "has-success")
-               (form-status-handler "has-error"))))
-         error-handler))
-      1000))))
+  (let [pr (split gh-repo "/")
+        user (first pr)
+        repo (second pr)]
+    (form-handler
+     (if (or (nil? repo)
+             (nil? user)
+             (= "" user)
+             (= "" repo))
+       (do
+         (form-status-handler "has-warning")
+         nil)
+
+       (js/setTimeout
+        (fn []
+          (action/get-github-repos
+           user
+           (fn [reply]
+             (let [rest (js->clj reply)
+                   result (->> rest
+                               (map #(get % "name"))
+                               (filter #(= % repo)))]
+               (if (first result)
+                 (form-status-handler "has-success")
+                 (form-status-handler "has-error"))))
+           error-handler))
+        1000)))))

 (defn github-issue-component [data owner]
   (reify
     om/IInitState
     (init-state [this]
       {:form-status
-       (let [v (:value (:user data))]
+       (let [v (:value (:repo data))]
          (if (or (nil? v) (= "" v))
            "has-warning"
            "has-success"))
@@ -130,35 +134,21 @@
       (dom/div nil
                (dom/div #js {:className (str "form-group " (:form-status state))}
                         (dom/label nil "GitHub repository")
-                        (dom/div #js {:className "form-inline"}
-                                 (dom/input #js {:type "text"
-                                                 :className "form-control"
-                                                 :value (:value (:user data))
-                                                 :placeholder "username or organization"
-                                                 :onChange #(github-issue-on-change
-                                                             (.. % -target -value)
-                                                             (:value (:repo data))
-                                                             (:timer state)
-                                                             (fn [t]
-                                                               ((:handler (:user data)) (.. % -target -value))
-                                                               (om/set-state! owner :timer t))
-                                                             (fn [st] (om/set-state! owner :form-status st))
-                                                             (fn [st] (om/set-state! owner :form-status "has-error")))
-                                                 })
-                                 (dom/span nil " / ")
-                                 (dom/input #js {:type "text"
-                                                 :className "form-control"
-                                                 :value (:value (:repo data))
-                                                 :placeholder "repository"
-                                                 :onChange #(github-issue-on-change
-                                                             (:value (:user data))
-                                                             (.. % -target -value)
-                                                             (:timer state)
-                                                             (fn [t]
-                                                               ((:handler (:repo data)) (.. % -target -value))
-                                                               (om/set-state! owner :timer t))
-                                                             (fn [st] (om/set-state! owner :form-status st))
-                                                             (fn [st] (om/set-state! owner :form-status "has-error")))})))
+                        (dom/input #js {:type "text"
+                                        :className "form-control"
+                                        :value (:value (:repo data))
+                                        :placeholder "github username or organization/repository"
+
+                                        :onChange
+                                        #(github-issue-on-change
+                                          (.. % -target -value)
+                                          (:timer state)
+                                          (fn [t]
+                                            ((:handler (:repo data)) (.. % -target -value))
+                                            (om/set-state! owner :timer t))
+                                          (fn [st] (om/set-state! owner :form-status st))
+                                          (fn [st] (om/set-state! owner :form-status "has-error")))
+                                        }))
                (dom/div #js {:className "form-group"}
                         (dom/label nil "Issue title")
                         (dom/input #js {:type "text"
@@ -196,13 +186,12 @@
             email (:user-email data)
             template (:email-template data)
             gh-repo (:gh-repo data)
-            gh-user (:gh-user data)
             gh-issue-title (:gh-issue-title data)
             gh-issue-body (:gh-issue-body data)
             data-pack {:type type
                        :project-id project-id
                        :artifact-value artifact
-                       :gh-repo (str gh-user "/" gh-repo)
+                       :gh-repo gh-repo
                        :gh-issue-title gh-issue-title
                        :gh-issue-body gh-issue-body
                        :user-email email
@@ -229,14 +218,13 @@
             email (:user-email data)
             template (:email-template data)
             gh-repo (:gh-repo data)
-            gh-user (:gh-user data)
             gh-issue-title (:gh-issue-title data)
             gh-issue-body (:gh-issue-body data)
             data-pack {:type type
                        :project-id project-id
                        :artifact-value artifact
                        :action-id action-id
-                       :gh-repo (str gh-user "/" gh-repo)
+                       :gh-repo gh-repo
                        :gh-issue-title gh-issue-title
                        :gh-issue-body gh-issue-body
                        :user-email email
@@ -267,7 +255,6 @@
 (def email-init-state {:email-template default-email-template})
 (def github-issue-init-state
   {:gh-repo ""
-   :gh-user ""
    :gh-issue-title default-github-issue-title
    :gh-issue-body default-github-issue-body})

@@ -288,16 +275,12 @@
    {:email-template (get action "template")}
     github-issue-init-state))

-(defmethod get-init-state-by-action "github-issue" [action]
-  (let [repo (split (get action "repo") "/")
-        user (first repo)
-        repository (second repo)]
+(defmethod get-init-state-by-action "github-issue" [action]
   (merge
    {:gh-issue-title (get action "title")
     :gh-issue-body (get action "body")
-    :gh-user user
-    :gh-repo repository}
-   email-init-state)))
+    :gh-repo (get action "repo")}
+   email-init-state))

 (defmethod get-init-state :update [data _]
   (let [action (:action data)]
@@ -352,9 +335,7 @@
                              :handler #(om/set-state! owner :type %)}

                             :github-issue
-                            {:user {:value (:gh-user state)
-                                    :handler #(om/set-state! owner :gh-user %)}
-                             :repo {:value (:gh-repo state)
+                            {:repo {:value (:gh-repo state)
                                     :handler #(om/set-state! owner :gh-repo %)}
                              :title {:value (:gh-issue-title state)
                                      :handler #(om/set-state! owner :gh-issue-title %)}


+(deftest speed-test)

+(deftest speed-test)

--- test/babel/test/fr.cljc
+++ test/babel/test/fr.cljc
@@ -327,7 +327,6 @@
                                          :aspect :progressive}}
                           :root {:français {:français "commencer"}}})]
     (is (= "elles commençaient" (fo result)))))
-

 (deftest generate-imparfait-regular-ir
   (let [result (generate {:synsem {:subcat '()
@@ -644,7 +643,108 @@
     (is (= "nous acheterons" (fo generated)))))

-
-
-
-
+(deftest speed-test
+  ;; these should all take relatively the same time, but
+  ;; for now, the more general the spec, the longer it takes to generate
+  (is (= 10
+         (count (take 10
+                      (repeatedly
+                       #(time (println (fo (generate {:synsem {:subcat '()
+                                                               :sem {:pred :speak
+                                                                     :subj {:pred :noi}
+                                                                     :tense :past
+                                                                     :aspect :progressive}}}
+                                                     :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take 10
+                (repeatedly
+                 #(time (println
+                         (fo (generate {:synsem {:subcat '()
+                                                 :sem {:pred :speak
+                                                       :subj {:pred :noi}
+                                                       :tense :conditional}}}
+                                       :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take
+           10
+           (repeatedly
+            #(time (println
+                    (fo (generate {:synsem {:subcat '()
+                                            :sem {:pred :speak
+                                                  :tense :conditional}}}
+                                  :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take
+           10
+           (repeatedly
+            #(time (println
+                    (fo (generate {:synsem {:subcat '()
+                                            :sem {:pred :speak}}}
+                                  :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take
+           10
+           (repeatedly
+            #(time (println
+                    (fo (generate {:synsem {:subcat '()
+                                            :sem {:tense :conditional}}}
+                                  :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take 10
+                (repeatedly
+                 #(time (println
+                         (fo (generate {:synsem {:subcat '()}}
+                                       :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take 10
+                (repeatedly
+                 #(time (println
+                         (fo (generate {:synsem {:subcat '()
+                                                 :sem {:pred :speak
+                                                       :subj {:pred :noi}
+                                                       :tense :present
+                                                       :aspect :perfect}}}
+                                       :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take 10
+                (repeatedly
+                 #(time (println
+                         (fo (generate {:synsem {:subcat '()
+                                                 :sem {:pred :speak
+                                                       :tense :present
+                                                       :aspect :perfect}}}
+                                       :model (medium))))))))))
+  (is (nil? (println "------")))
+  (is (= 10
+         (count
+          (take 10
+                (repeatedly
+                 #(time (println
+                         (fo (generate {:synsem {:subcat '()
+                                                 :sem {:tense :present
+                                                       :aspect :perfect}}}
+                                       :model (medium)))))))))))
+
+
+
+
+
+
+
+
+
+


rm Process from cache if job throws exception

--- src/clj/jsk/ps.clj
+++ src/clj/jsk/ps.clj
@@ -111,9 +111,13 @@
     ; stick in cache so can be killed if need be by outside intervention
     (cache-ps exec-group-id exec-id (.process sp))

-    (let [^ProcessResult result (-> sp .future (.get timeout TimeUnit/SECONDS))]
-      (rm-from-cache exec-group-id exec-id)
-      {:exit-code (.exitValue result)})))
+    (try
+      (let [^ProcessResult result (-> sp .future (.get timeout TimeUnit/SECONDS))]
+        (rm-from-cache exec-group-id exec-id)
+        {:exit-code (.exitValue result)})
+      (catch Exception e
+        (rm-from-cache exec-group-id exec-id)
+        (throw e)))))

 (defn exec1
   "Takes a cmd with args to run and the directory in which it should be run"


Fix a reflection warning

Fix a reflection warning

--- src/cljam/util.clj
+++ src/cljam/util.clj
@@ -62,7 +62,7 @@
   (if-not (nil? s)
     (try
       (let [[n _ _] (re-matches #"(|-|\+)(\d+)" s)]
-        (Integer. n))
+        (Integer. ^String n))
       (catch NumberFormatException e
         (str->long s))
       (catch Exception e


Get rid of reflection warning.

Get rid of reflection warning.

--- src/fhofherr/clj_db_util/core.clj
+++ src/fhofherr/clj_db_util/core.clj
@@ -9,8 +9,7 @@
 (defn verify-connection
   [db]
   {:pre [db]}
-  (let [c (-> (:datasource db)
-              (.getConnection))]
+  (let [c  (.getConnection ^javax.sql.DataSource (:datasource db))]
     (try
       (.isValid c 5)
       (finally


restart julkiseksi

restart julkiseksi

--- mtg-pairings-server/dev/user.clj
+++ mtg-pairings-server/dev/user.clj
@@ -12,7 +12,7 @@
   ((:stop-fn @server))
   (reset! server nil))

-(defn ^:private restart! []
+(defn restart! []
   (when @server
     (stop!))
   (nsr/refresh :after 'user/start!))


Minor code cleanup :shower:

Minor code cleanup :shower:

--- src/metabase/api/database.clj
+++ src/metabase/api/database.clj
@@ -37,10 +37,11 @@

 (defn- add-native-perms-info [dbs]
   (for [db dbs]
-    (assoc db :native_permissions (cond
-                                    (perms/set-has-full-permissions? @*current-user-permissions-set* (perms/native-readwrite-path (u/get-id db))) :readwrite
-                                    (perms/set-has-full-permissions? @*current-user-permissions-set* (perms/native-read-path (u/get-id db)))      :read
-                                    :else                                                                                :none))))
+    (let [user-has-perms? (fn [f] (perms/set-has-full-permissions? @*current-user-permissions-set* (f (u/get-id db))))]
+      (assoc db :native_permissions (cond
+                                      (user-has-perms? perms/native-readwrite-path) :readwrite
+                                      (user-has-perms? perms/native-read-path)      :read
+                                      :else                                         :none)))))

 (defn- dbs-list [include-tables?]
   (when-let [dbs (seq (filter models/can-read? (db/select Database {:order-by [:%lower.name]})))]


fix: shape_reader reflection warnings

fix: shape_reader reflection warnings

--- src/main/clojure/pdok/featured/shape_reader.clj
+++ src/main/clojure/pdok/featured/shape_reader.clj
@@ -1,29 +1,33 @@
 (ns pdok.featured.shape-reader
   (:require [clojure.java.io :as io])
-  (:import [org.geotools.data DataStoreFinder]))
+  (:import [org.geotools.data DataStoreFinder DataStore]
+           [org.opengis.feature.simple SimpleFeature]
+           [org.opengis.feature.type AttributeDescriptor]))

-(defn shape-file-store [path]
+(defn shape-file-store ^DataStore [path]
   (let [url (-> path io/file .toURI str)
         config {"url" url}]
     (DataStoreFinder/getDataStore config)))

-(defn attributes [gt-feature]
-  (let [attribute-names (filter #(not (.contains % "geom"))
-                                (map #(.getLocalName %) (-> gt-feature .getFeatureType .getAttributeDescriptors)))
-        attributes (map #(vector %1 (.getAttribute gt-feature %1)) attribute-names)]
+(defn attributes [^SimpleFeature gt-feature]
+  (let [attribute-names (filter #(not (clojure.string/includes? % "geom"))
+                                (map (fn [^AttributeDescriptor d] (.getLocalName d))
+                                     (-> gt-feature .getFeatureType .getAttributeDescriptors)))
+        attributes (map (fn [^java.lang.String an] [an (.getAttribute gt-feature an)]) attribute-names)]
     attributes))

-(defn make-feature [dataset layer gt-feature]
+(defn make-feature [dataset layer ^SimpleFeature gt-feature]
   {:dataset dataset
    :collection layer
    :id (.getID gt-feature)
    :attributes (attributes gt-feature)
    :geometry {"type" "jts"  "jts" (.getDefaultGeometry gt-feature)}})

-(defn feature-sources [shape-store]
+(defn feature-sources [^DataStore shape-store]
   "Returns seq of [layer-name featurecollection] "
   (let [layers (seq (.getTypeNames shape-store))
-        sources (map #(vector %1 (-> shape-store (.getFeatureSource %1) .getFeatures)) layers)]
+        sources (map (fn [^java.lang.String l] [l (-> shape-store
+                                                     (.getFeatureSource l) .getFeatures)]) layers)]
     sources))

 (defmacro with-shape-features


Use environment variables if present

Use environment variables if present

--- src/robb1e/web.clj
+++ src/robb1e/web.clj
@@ -6,8 +6,14 @@
             [robb1e.controllers.home :as homeController])
   (:gen-class))

+(def port
+  (Integer. (or (System/getenv "PORT") "8080")))
+
+(def db
+  (or (System/getenv "DATABASE_URL") "postgresql://localhost:5432/robb1e"))
+
 (defroutes routes
-  (homeController/routes "postgresql://localhost:5432/robb1e")
+  (homeController/routes db)
   (route/resources "/"))

 (def application (handler/site routes))
@@ -16,4 +22,4 @@
   (container/run-jetty application {:port port :join? false}))

 (defn -main []
-  (start 8080))
+  (start port))


more tests for utils

more tests for utils

--- test/hsm/test_utils.clj
+++ test/hsm/test_utils.clj
@@ -2,7 +2,7 @@
 	(:use midje.sweet)
 	(:require		[hsm.utils :refer :all]))

-(tabular
+(tabular
 	(fact "Domain name resolution"
 		(domain-of {:headers { "host" ?host }} ) => ?result )
 		?host ?result
@@ -10,14 +10,14 @@
 		"pythonhackers.com" 				["pythonhackers" "com"]
 		"www.clojurehackers.com" 		["www" "clojurehackers" "com"])

-(tabular
+(tabular
 	(fact "Find Host of the Request"
 		(host-of {:headers { "host" ?host }} ) => ?result)
 		?host ?result
 		 "dev.pythonhackers.com" "dev.pythonhackers.com"
 		 "clojurehackers.com" "clojurehackers.com")

-(tabular
+(tabular
 	(fact "Empty Host Request with falsy hash-map "
 		(host-of ?request ) => ?result)
 		?request ?result
@@ -25,9 +25,31 @@
 		 {:headers2 "test"} nil)

 ; Well Token fetcher always returns the same ID for right now! Very effective!! :)
-(tabular
+(tabular
 	(fact "Find User Token"
 		(whois {:headers { "X-AUTH-TOKEN" ?token }}) => ?result)
 		?token ?result
 		1 243975551163827208
-		)+		)
+
+(tabular
+	(fact "Select Values of a Hash-Map"
+		(select-values ?hashmap ?keys) => ?result)
+		?hashmap ?keys ?result
+		{:a 1 :b 2} [:a :b] [1 2]
+		{:a 1 :b 2} [:a] [1]
+		{:a 1 :b 2} [] []
+		{:a 1 :b 2} nil []
+		)
+
+(let [temp-file (java.io.File/createTempFile (str "body-test" (now->ep)) ".txt")]
+	(doto (clojure.java.io/writer temp-file)
+		(.write "testing")
+		(.close))
+	(tabular
+		(fact "Body Slurping"
+			(body-as-string {:body ?body}) => ?result)
+			?body ?result
+			"test" "test"
+			temp-file "testing")
+	(.delete temp-file))


Error data and file size

Error data and file size

--- src/atom_finder/atom_patch.clj
+++ src/atom_finder/atom_patch.clj
@@ -123,12 +123,14 @@
                                        (s/required-key :patch-chars) s/Int}]
   "For every file changed in this commit, give both before and after ASTs"
   [repo rev-commit :- RevCommit]
-  (->> (edited-files repo rev-commit)
-       (map #(merge {:file %1
-                     :patch-chars (count (commit-file-source repo rev-commit %1))}
-                    (zipmap [:source-before :source-after]
-                            (source-before-after repo rev-commit %1))))
-       ))
+  (for [edited-file (edited-files repo rev-commit)]
+    (let [[source-before source-after] (source-before-after repo rev-commit edited-file)]
+      {:file edited-file
+       :file-size-before (count source-before)
+       :file-size-after (count source-after)
+       :source-before source-before
+       :source-after source-after}
+      )))

 (s/defn atoms-changed-in-commit ;:- {s/Str {s/Keyword BACounts}}
   [repo :- Git atoms :- [Atom] rev-commit :- RevCommit]
@@ -144,8 +146,8 @@
     (try
       (doall (for [atom (atoms-changed-in-commit repo atoms rev-commit)]
         (merge {:revstr commit-hash :bug-ids (bugzilla-ids rev-commit)} atom)))
-      (catch Exception e (do (errln "-- exception parsing commit: \"" commit-hash "\"\n" ) [commit-hash nil nil]))
-      (catch Error e     (do (errln "-- error parsing commit: \""  commit-hash "\"\n") [commit-hash nil nil]))
+      (catch Exception e (do (errln "-- exception parsing commit: \"" commit-hash "\"\n" ) {:revstr commit-hash}))
+      (catch Error e     (do (errln "-- error parsing commit: \""  commit-hash "\"\n") {:revstr commit-hash}))
     )))

       (try (/ 1 0) (catch Exception e "oops"))
@@ -186,9 +188,9 @@
          dorun
          time)))

-
-;(def filename "gcc-bugs-atoms_2017-03-20_2.edn")
-;(def gcc-bugs (->> filename read-patch-data))
+;(def filename "gcc-bugs-atoms_2017-03-26_2_1000.edn")
+;(def gcc-bugs (->> filename read-data (mapcat identity) (filter :revstr)))
+;(->> gcc-bugs add-convenience-columns (write-res-csv "gcc-bugs_2017-03-26_2_1000.csv"))

 (defn write-res-csv
   [filename flat-res]


fix typo

fix typo

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1471,7 +1471,7 @@
    {:english {:past {:english "read"
                      :note "past tense"}}
     :synsem {:cat :verb
-             :sem {:pred :leggere
+             :sem {:pred :read
                    :discrete false
                    :subj {:human true}
                    :obj {:legible true}}}}


+add default rule

+add default rule

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2121,11 +2121,16 @@
                               morph/exception-generator
                               morph/phonize morph/english-specific-rules)

+                 ;; add a second argument to every verb, unless it's explicitly disallowed with {:2 '()}.
+                 (default
+                  {:synsem {:cat :verb
+                            :subcat {:2 {:cat :top}}}})
+
                  ;; add :sem :obj if necessary, so that intransitivize is triggered.
                  (if-then {:synsem {:cat :verb
                                     :subcat {:2 {:cat :noun}}}}
                           {:synsem {:sem {:obj {:pred :top}}}})
-
+
                  ;; make an intransitive version of every verb which has an
                  ;; [:sem :obj] path.
                  intransitivize


remove {:mass false} from "the"; since it can be used with mass=true nouns ; e.g. "the music"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1359,8 +1359,7 @@
                     :sem {:pred :tell}}}
    "the" (map #(unify %
                       {:synsem {:cat :det
-                                :def :def
-                                :mass false}})
+                                :def :def}})
               [{:synsem {:agr {:number :sing}}}
                {:synsem {:agr {:number :plur}}}])


added mv command

added mv command

--- src/mapfs/core.clj
+++ src/mapfs/core.clj
@@ -99,6 +99,7 @@
   [(pop path) (last path)])

 (defn rename
+  "Rename file to path. Arguments should be [:src :key :path] [:dest :key :path]."
   [src dest]
   (let [src-path (resolve-path src)
         src-val (get-in @FS_ROOT src-path)
@@ -151,6 +152,13 @@
           (swap! FS_ROOT update-in @CURRENT_DIR dissoc key-name))
         (str "Path removed: " path)))))

+(defn mv
+  "Move file to path. (Currently an alias to rename)."
+  [src dest]
+  (rename src dest))
+
+;; SHELL COMMANDS
+
 (defn help
   "Print available commands."
   []
@@ -159,6 +167,8 @@
       (map (fn [[k v]] (str "  " k " - " (:doc (meta v)))) publics)
       (into ["Available commands:\n"])
       (str/join "\n" ))))
+
+;; SHELL CODE

 (def ^:private completion-handler
   (reify


+(def tenses)

+(def tenses)

--- src/babel/espanol/grammar.cljc
+++ src/babel/espanol/grammar.cljc
@@ -25,6 +25,15 @@
   [[:synsem :cat]
    [:synsem :aux]
    [:synsem :sem :pred]])
+
+(def tenses
+  {"present" {:synsem {:sem {:tense :present}}}
+   "conditional" {:synsem {:sem {:tense :conditional}}}
+   "future" {:synsem {:sem {:tense :future}}}
+   "imperfect" {:synsem {:sem {:aspect :progressive
+                                :tense :past}}}
+   "preterito" {:synsem {:sem {:aspect :perfect
+                             :tense :past}}}})

 (defn fo-ps [expr]
   (parse/fo-ps expr fo))


further implementing...

further implementing...

--- src/mapfs/core.clj
+++ src/mapfs/core.clj
@@ -3,14 +3,18 @@
             [clojure.edn :as edn])
   (:gen-class :main true))

-(defonce FS_ROOT (atom nil))
+(defonce ^:private FS_ROOT (atom nil))

-(defonce CURRENT_DIR (atom []))
+(defonce ^:private CURRENT_DIR (atom []))

-(defn write-fs! [filename]
+(defn write-fs!
+  "Write current filesystem to filename as EDN."
+  [filename]
   (spit filename (pr-str @FS_ROOT)))

-(defn load-fs! [filename]
+(defn load-fs!
+  "Load EDN from filename as current filesystem."
+  [filename]
   (if (.exists (java.io.File. filename))
     (with-open [r (java.io.PushbackReader.
                     (clojure.java.io/reader filename))]
@@ -18,51 +22,118 @@
     (throw (Exception. "File not found :("))))

 (defn mount
+  "Mounts a map as the current filesystem."
   [m]
   (reset! FS_ROOT m))

-(defn ls []
-  (doseq [ks (keys (get-in @FS_ROOT @CURRENT_DIR))]
-    (let [path (conj @CURRENT_DIR ks)
-          v (get-in @FS_ROOT path)]
-      (if (and (map? v) (not (:tag v)))
-        (println (str "[" ks "]"))
-        (println ks)))))
+(defn is-dir?
+  "Checks if value is a directory (is a map and does not have :tag key)"
+  [v]
+  (and (map? v) (not (:tag v))))

-(defn pwd []
-  @CURRENT_DIR)
-
-(defn resolve-path
+(defn- resolve-path
   [parts]
   (reduce #(if (= :.. %2) (pop %1) (conj %1 %2))
           @CURRENT_DIR parts))

+(defn ls
+  "List keys in current directory of filesystem, or given path."
+  [& path-keys]
+  (->>
+    (keys (get-in @FS_ROOT (resolve-path path-keys)))
+    (map
+      #(let [path (conj @CURRENT_DIR %)
+             v (get-in @FS_ROOT path)]
+         (if (is-dir? v)
+           (str "D " %)
+           (str "- " %))))
+    (str/join "\n")))
+
+(defn pwd
+  "Print current working directory."
+  []
+  @CURRENT_DIR)
+
 (defn cd
+  "Changes working directory to new path. Can use :.. as relative location, one up in path."
   [& parts]
   (let [new-path (resolve-path parts)]
-    (reset! CURRENT_DIR new-path)))
+    (reset! CURRENT_DIR new-path)
+    (str "Current path: " new-path)))

 (defn cp
+  "Copy value from [src path] to [dest path]. src and dest should be relative path vectors."
   [src dest]
   (let [src-path (resolve-path src)
         dest-path (resolve-path dest)]
-    (swap! FS_ROOT assoc-in dest-path (get-in @FS_ROOT src-path))))
+    (swap! FS_ROOT assoc-in dest-path (get-in @FS_ROOT src-path))
+    (str "Copied value from " src-path " to " dest-path)))

-(defn cat [key-name]
+(defn cat
+  "Prints value of :key-name associated in current directory."
+  [key-name]
   (get-in @FS_ROOT (into @CURRENT_DIR [key-name])))

-(defn put [key-name value]
+(defn put
+  "Associates a new value in current directory with key-name/value."
+  [key-name value]
   (swap! FS_ROOT assoc-in (into @CURRENT_DIR [key-name]) value))

-(defn mkdir [key-name]
-  (put key-name {}))
+(defn mkdir
+  "Creates an empty directory (map) with key-name in working directory."
+  [key-name]
+  (put key-name {})
+  (str "New path created: " (resolve-path [key-name])))

-(defn print-path []
-  (print @CURRENT_DIR "> "))
+(defn rmdir
+  "Removes a directory"
+  [key-name]
+  (let [path (resolve-path [key-name])
+        v (get-in @FS_ROOT path)]
+    (cond
+      (nil? v)
+      (str "Error: path is nil: " path)
+      (is-dir? v)
+      (do
+        (if (zero? (count @CURRENT_DIR))
+          (swap! FS_ROOT dissoc key-name)
+          (swap! FS_ROOT update-in @CURRENT_DIR dissoc key-name))
+        (str "Path removed: " path))
+      :else
+      (str "Error: Path is not a directory: " path))))
+
+(defn rm
+  "Removes a value"
+  [key-name]
+  (let [path (resolve-path [key-name])
+        v (get-in @FS_ROOT path)]
+    (cond
+      (nil? v)
+      (str "Error: path is nil: " path)
+      (is-dir? v)
+      (str "Error: Path is not a directory: " path)
+      :else
+      (do
+        (if (zero? (count @CURRENT_DIR))
+          (swap! FS_ROOT dissoc key-name)
+          (swap! FS_ROOT update-in @CURRENT_DIR dissoc key-name))
+        (str "Path removed: " path)))))
+
+(defn help
+  "Print available commands."
+  []
+  (let [publics (sort-by first (ns-publics 'mapfs.core))]
+    (->>
+      (map (fn [[k v]] (str "  " k " - " (:doc (meta v)))) publics)
+      (into ["Available commands:\n"])
+      (str/join "\n" ))))

 (defn -main [& args]
   (println "Map FS - 0.1.0")
   (in-ns 'mapfs.core)
+  (when (pos? (count args))
+    (load-fs! (first args))
+    (println "Loading Filesystem: " (first args)))
   (loop []
     (println)
     (let [v (read-line)]


add {:reflexive false}for "bere"

add {:reflexive false}for "bere"

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -355,6 +355,7 @@
      :synsem {:cat :verb
               :essere false
               :sem {:pred :drink
+                    :reflexive false
                     :subj {:animate true}
                     :obj {:drinkable true}}}}


Use set-state! when cataloging

Use set-state! when cataloging

So that a notification is sent to the erp system

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -153,13 +153,10 @@
                            (layout/glyphicon "transfer")]])]])]])))

 (defn production-catalog [id library_signature]
-  (let [p (assoc
-           (prod/find id)
-           :library_signature library_signature
-           ;; the state is implicitly set to :cataloged if the
-           ;; library_signature is set
-           :state "cataloged")]
-    (prod/update! p)
+  (let [p (assoc (prod/find id) :library_signature library_signature)]
+    ;; the state is implicitly set to :cataloged if the
+    ;; library_signature is set
+    (prod/set-state! p "cataloged")
     ;; put the production on the archive queue
     (msg/publish (queues/archive) p)
     (response/redirect "/")))


fix compilation error

fix compilation error

--- src/shuppet/s3.clj
+++ src/shuppet/s3.clj
@@ -40,9 +40,8 @@
       "")))

 (def create-bucket-body
-  (emit-str (sexp-as-element
-             [:CreateBucketConfiguration {}
-              [:LocationConstraint location]])))
+  (emit-str (element :CreateBucketConfiguration {}
+             (element :LocationConstraint {} location))))

 (def s3-sub-resources #{:versioning :location :acl :torrent
                         :lifecycle :versionId :logging :notification


Ring stuff: Wrapping both requests and responses

--- test/com/nomistech/clojure_the_language/c_800_libraries/s_800_web/ss_020_ring.clj
+++ test/com/nomistech/clojure_the_language/c_800_libraries/s_800_web/ss_020_ring.clj
@@ -67,3 +67,30 @@
   => {:status 200
       :headers {"Content-Type" "application/json; charset=utf-8"}
       :body "{\"foo\":\"bar\"}"})
+
+;;;; ___________________________________________________________________________
+;;;; ---- Wrapping requests and responses ----
+
+(defn handler-with-interesting-request-and-response [request]
+  (let [user (get-in request [:body :user] "<no user specified>")]
+    (rur/response {:uploaded-user user})))
+
+(def wrapped-handler-with-interesting-request-and-response
+  (-> handler-with-interesting-request-and-response
+      (rmj/wrap-json-body {:keywords? true
+                           :bigdecimals? true})
+      rmj/wrap-json-response))
+
+(fact "Handler with request whose body is Clojure data"
+  (handler-with-interesting-request-and-response {:body {:user "Fred"}})
+  => {:status 200
+      :headers {}
+      :body {:uploaded-user "Fred"}})
+
+(fact "Wrapped handler with request whose body is JSON"
+  (wrapped-handler-with-interesting-request-and-response
+   {:headers {"content-type" "application/json; charset=utf-8"}
+    :body (string->stream "{\"user\":\"Fred\"}")})
+  => {:status 200
+      :headers {"Content-Type" "application/json; charset=utf-8"}
+      :body "{\"uploaded-user\":\"Fred\"}"})


Improve readability of test warning

Improve readability of test warning

--- test/uruk/core_test.clj
+++ test/uruk/core_test.clj
@@ -221,7 +221,9 @@
           opts {:default-request-options {:auto-retry-delay-millis 98
                                           :cache-result false
                                           :default-xquery-version "0.9-ml"
-                                          :effective-point-in-time (.getCurrentServerPointInTime dummy-session) ;; XXX requires xdmp:timestamp privilege
+                                          ;; XXX requires `xdmp:timestamp` privilege:
+                                          :effective-point-in-time (.getCurrentServerPointInTime
+                                                                    dummy-session)
                                           :locale (Locale. "ru")
                                           :max-auto-retry 17
                                           :query-language "de"


Fixed doc string

Fixed doc string

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -265,8 +265,8 @@

    If the call doesn't mention any namespaces, the ones from the
    previous `load-facts`, `check-facts`, or `fetch-facts` are
-   reused. The filters and print-levels are also reused, unless
-   they're overridden with explicit arguments.
+   reused. The filters are also reused, unless they're overridden
+   with explicit arguments.
    "
 )


fix typo

fix typo

--- src/useful/map.clj
+++ src/useful/map.clj
@@ -119,7 +119,7 @@
   (update-in! m ks (constantly v)))

 (defn dissoc-in
-  "Associates a value in a nested associative structure, where ks is a sequence of keys and returns
+  "Dissociates a value in a nested associative structure, where ks is a sequence of keys and returns
   a new nested structure. If any resulting maps are empty, they will be removed from the new
   structure. This implementation was adapted from clojure.core.contrib, but the behavior is more
   correct if keys is empty."