for now, don't use rtm slack API

for now, don't use rtm slack API

--- src/clj/tictag/slack.clj
+++ src/clj/tictag/slack.clj
@@ -1,24 +1,27 @@
 (ns tictag.slack
-  (:require [slack-rtm.core :as slack]
-            [org.httpkit.client :as http]
+  (:require [org.httpkit.client :as http]
             [com.stuartsierra.component :as component]
             [cheshire.core :as json]
             [tictag.cli :refer [handle-command]]
             [tictag.db :as db]
             [clojure.string :as str]))

-(defn dispatcher [slack]
-  (:dispatcher (:conn slack)))
+(def slack-api-url "https://slack.com/api/")
+(defn method-url [m] (str slack-api-url m))
+(defn slack-call! [cmd params]
+  (-> (method-url cmd)
+      (http/post {:form-params params})
+      deref
+      :body
+      (json/parse-string true)))

-(defn pub [slack]
-  (:events-publication (:conn slack)))

 (defn send-message! [slack body]
-  (let [{:keys [dm-channel-id]} slack]
-    (slack/send-event (dispatcher slack)
-                      {:type "message"
-                       :text body
-                       :channel dm-channel-id})))
+  (let [{:keys [dm-channel-id config]} slack]
+    (slack-call! "chat.postMessage"
+                 {:token   (:token config)
+                  :channel dm-channel-id
+                  :text    body})))

 (defn handle-message [component message]
   (when (and (= (:dm-channel-id component) (:channel message))
@@ -37,29 +40,14 @@
 (defrecord Slack [config db]
   component/Lifecycle
   (start [component]
-    (let [user-list     (-> "https://slack.com/api/users.list"
-                            (http/get {:query-params {:token (:token config)}})
-                            deref
-                            :body
-                            (json/parse-string true)
-                            :members)
+    (let [user-list     (:members (slack-call! "users.list" {:token (:token config)}))
           [my-user]     (filter #(= (:name %) (:username config)) user-list)
-          dm-channel-id (-> "https://slack.com/api/im.open"
-                            (http/get {:query-params {:token (:token config)
-                                                      :user  (:id my-user)}})
-                            deref
-                            :body
-                            (json/parse-string true)
-                            :channel
-                            :id)
-          conn          (slack/connect (:token config))
-          new-component (assoc component
-                               :user my-user
-                               :conn conn
-                               :dm-channel-id dm-channel-id)]
-      (slack/sub-to-event (:events-publication conn) :message (partial handle-message new-component))
-      new-component))
-  (stop [component]
-    (when-let [conn (:conn component)]
-      (slack/send-event (:dispatcher conn) :close))))
+          dm-channel-id (:id
+                         (:channel
+                          (slack-call!
+                           "im.open"
+                           {:token (:token config)
+                            :user  (:id my-user)})))]
+      (assoc component :user my-user :dm-channel-id dm-channel-id)))
+  (stop [component] component))


Namespace cleanup

Namespace cleanup

--- src/clj/zetawar/app.cljs
+++ src/clj/zetawar/app.cljs
@@ -7,8 +7,7 @@
    [zetawar.db :refer [e find-by qe qes]]
    [zetawar.data :as data]
    [zetawar.game :as game]
-   [zetawar.hex :as hex]
-   [zetawar.util :refer [breakpoint inspect oonly]]))
+   [zetawar.util :refer [breakpoint inspect]]))

 (defn root [db]
   (qe '[:find ?a


Cleanup gampg.core ns

Cleanup gampg.core ns

--- src/cljs/gampg/core.cljs
+++ src/cljs/gampg/core.cljs
@@ -1,11 +1,5 @@
 (ns ^:figwheel-always gampg.core
-  (:require [clojure.string :as s]
-            [gamma.api :as g]
-            [gamma.program :as p]
-            [gamma.tools :as gt]
-            [gamma-driver.drivers.basic :as driver]
-            [gamma-driver.protocols :as dp]
-            [gampg.learn-gamma.lesson-01 :as lg01]
+  (:require [gampg.learn-gamma.lesson-01 :as lg01]
             [gampg.learn-gamma.lesson-02 :as lg02]
             [gampg.learn-gamma.lesson-03 :as lg03]
             [gampg.learn-gamma.lesson-04 :as lg04]
@@ -16,7 +10,6 @@
             [gampg.learn-gamma.lesson-09 :as lg09]
             [gampg.learn-gamma.lesson-10 :as lg10]
             [gampg.learn-gamma.gltf :as lg-gltf]
-            [goog.webgl :as ggl]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]))

@@ -27,7 +20,7 @@
 ;; XXX: We're not properly reusing gl context's here, hurts fighweel's
 ;; reloadability
 (def title   lg-gltf/title)
-(def prog    lg-gltf/program-source)
+(def prog    lg-gltf/program-texture-light)
 (def gl-main lg-gltf/main)

 (defonce app-state (atom {:live {}}))


Add difference-from-most-similar-parent meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -281,6 +281,12 @@
                 (max (sequence-similarity (:genome ind) (:parent1-genome ind))
                      (sequence-similarity (:genome ind) (:parent2-genome ind)))
                 1.0)
+              ;
+              (= cat :difference-from-most-similar-parent)
+              (- 1.0 (if (and (:parent1-genome ind) (:parent2-genome ind))
+                       (max (sequence-similarity (:genome ind) (:parent1-genome ind))
+                            (sequence-similarity (:genome ind) (:parent2-genome ind)))
+                       1.0))
               ;
               (= cat :reproductive-convergence)
               (if (and (:parent1-genome ind) (:parent2-genome ind))


more TODO

more TODO

--- test/com/billpiel/mem_tracer/core_test.clj
+++ test/com/billpiel/mem_tracer/core_test.clj
@@ -575,11 +575,19 @@
 - use pmap all over the place?
   -- add pmap mode to walk18???
 x ws-load bug???
-- profiling features
+x profiling features
   x use joda
   x arg cardinality
 x aliases for core fns
-- have all core rec fns optionally take an arg
+? have all core rec fns optionally take an arg
+x split out and memoize arg map fn
+  - was this actually an improvement???
+- speed up
+  - load recording from ws
+  - string out
+  - querying
+  - deref?
+- rec-save-as should accept keyword or string
 - never return ws or recs from core fns
 - deep trace (inside fn)
 - cursors


adding type hints to clean boxed operations with java.lang.Objects

--- modules/reitit-core/src/reitit/trie.cljc
+++ modules/reitit-core/src/reitit/trie.cljc
@@ -22,7 +22,7 @@
 (defprotocol Matcher
   (match [this i max path])
   (view [this])
-  (depth [this])
+  (depth ^long [this])
   (length [this]))

 (defprotocol TrieCompiler
@@ -53,7 +53,7 @@
         :else (recur (inc i))))))

 (defn- -keyword [s]
-  (if-let [i (str/index-of s "/")]
+  (if-let [^long i (str/index-of s "/")]
     (keyword (subs s 0 i) (subs s (inc i)))
     (keyword s)))

@@ -61,8 +61,8 @@
   (let [bracket? (-> syntax (into-set) :bracket)
         colon? (-> syntax (into-set) :colon)
         -static (fn [from to] (if-not (= from to) [(subs s from to)]))
-        -wild (fn [from to] [(->Wild (-keyword (subs s (inc from) to)))])
-        -catch-all (fn [from to] [(->CatchAll (keyword (subs s (inc from) to)))])]
+        -wild (fn [^long from to] [(->Wild (-keyword (subs s (inc from) to)))])
+        -catch-all (fn [^long from to] [(->CatchAll (keyword (subs s (inc from) to)))])]
     (loop [ss nil, from 0, to 0]
       (if (= to (count s))
         (concat ss (-static from to))
@@ -70,13 +70,13 @@
           (cond

             (and bracket? (= \{ c))
-            (let [to' (or (str/index-of s "}" to) (ex/fail! ::unclosed-brackets {:path s}))]
+            (let [^long to' (or (str/index-of s "}" to) (ex/fail! ::unclosed-brackets {:path s}))]
               (if (= \* (get s (inc to)))
                 (recur (concat ss (-static from to) (-catch-all (inc to) to')) (long (inc to')) (long (inc to')))
                 (recur (concat ss (-static from to) (-wild to to')) (long (inc to')) (long (inc to')))))

             (and colon? (= \: c))
-            (let [to' (or (str/index-of s "/" to) (count s))]
+            (let [^long to' (or (str/index-of s "/" to) (count s))]
               (if (= 1 (- to' to))
                 (recur ss from (inc to))
                 (recur (concat ss (-static from to) (-wild to to')) (long to') (long to'))))
@@ -115,7 +115,7 @@
                    (and (string? cp) (not= (count cp) (count p))) [(subs p (count cp))]
                    (and (string? p) (not cp)) (-split p)))
         -postcut (fn [[p :as pps]]
-                   (let [i (and p (str/index-of p "/"))]
+                   (let [^long i (and p (str/index-of p "/"))]
                      (if (and i (pos? i))
                        (concat [(subs p 0 i) (subs p i)] (rest pps))
                        pps)))
@@ -128,7 +128,7 @@

 (defn- -slice-end [x xs]
   (let [i (if (string? x) (str/index-of x "/"))]
-    (if (and (number? i) (pos? i))
+    (if (and (number? i) (pos? ^long i))
       (concat [(subs x i)] xs)
       xs)))

@@ -227,11 +227,11 @@
       (let [size (count path)]
         (reify Matcher
           (match [_ i max p]
-            (if-not (< max (+ i size))
+            (if-not (< ^long max (+ ^long i size))
               (loop [j 0]
                 (if (= j size)
-                  (match matcher (+ i size) max p)
-                  (if (= (get p (+ i j)) (get path j))
+                  (match matcher (+ ^long i size) max p)
+                  (if (= (get p (+ ^long i j)) (get path j))
                     (recur (inc j)))))))
           (view [_] [path (view matcher)])
           (depth [_] (inc (depth matcher)))
@@ -239,8 +239,8 @@
     (wild-matcher [_ key end matcher]
       (reify Matcher
         (match [_ i max path]
-          (if (and (< i max) (not= (get path i) end))
-            (loop [percent? false, j i]
+          (if (and (< ^long i ^long max) (not= (get path i) end))
+            (loop [percent? false, j ^long i]
               (if (= max j)
                 (if-let [match (match matcher max max path)]
                   (assoc-param match key (decode path i max percent?)))
@@ -257,7 +257,7 @@
       (let [match (->Match params data)]
         (reify Matcher
           (match [_ i max path]
-            (if (<= i max) (assoc-param match key (decode path i max true))))
+            (if (<= ^long i ^long max) (assoc-param match key (decode path i max true))))
           (view [_] [key [data]])
           (depth [_] 1)
           (length [_]))))
@@ -271,7 +271,7 @@
                 (or (match (get matchers j) i max path)
                     (recur (inc j))))))
           (view [_] (mapv view matchers))
-          (depth [_] (inc (apply max 0 (map depth matchers))))
+          (depth [_] (inc ^long (apply max 0 (map depth matchers))))
           (length [_]))))
     (-pretty [_ matcher]
       (view matcher))


Fixed another test.

Fixed another test.

--- test/onyx/log/notify_join_cluster_test.clj
+++ test/onyx/log/notify_join_cluster_test.clj
@@ -17,8 +17,7 @@
       diff (rep-diff old-replica new-replica)
       reactions (rep-reactions old-replica new-replica diff {:id :d})]
   (fact diff => {:observer :d :subject :b :accepted-joiner :d :accepted-observer :a})
-  (fact reactions => [{:fn :accept-join-cluster
-                       :args diff}])
+  (fact reactions => [{:fn :accept-join-cluster :args diff :immediate? true}])
   (fact (rep-reactions old-replica new-replica diff {:id :a}) => nil)
   (fact (rep-reactions old-replica new-replica diff {:id :b}) => nil)
   (fact (rep-reactions old-replica new-replica diff {:id :c}) => nil))


Remove obsolete comments.

Remove obsolete comments.

--- src/boot/jruby.clj
+++ src/boot/jruby.clj
@@ -18,8 +18,6 @@

 (defn make-jruby
   []
-  ;; TODO: figure out what keys (if any) these should have
-  ;; TODO: replace with new tempfile mechanism when it is released
   (let [pod (pods :refresh)
         tgt (boot/temp-dir!)
         src (boot/temp-dir!)


Removing unneccessary prn statement.

Removing unneccessary prn statement.

--- test/clojars/test/integration/search.clj
+++ test/clojars/test/integration/search.clj
@@ -73,7 +73,6 @@
     (testing "json request with invalid page returns error"
       (let [resp (do-search-with-page :json "test" "a" {:throw-exceptions false})
             result (json/parse-string (:body resp) true)]
-        (prn resp)
         (is (= 400 (:status resp)))
         (is (= "application/json" (help/get-content-type resp)))
         (is (not (nil? (:error result))))


added svg viewer

added svg viewer

--- src/dj/gui/svg.clj
+++ src/dj/gui/svg.clj
@@ -22,6 +22,24 @@
     (doto f
       (.pack)
       (.setVisible true))))
+
+(defn view! [args]
+  (let [default {:title "Replace me!"}
+        {:keys [title svg-str]} (merge default args)]
+    (javax.swing.SwingUtilities/invokeLater
+     (fn []
+       (let [f (javax.swing.JFrame. title)
+             s (org.apache.batik.swing.JSVGCanvas.)
+             parser (org.apache.batik.util.XMLResourceDescriptor/getXMLParserClassName)
+             df (org.apache.batik.anim.dom.SAXSVGDocumentFactory. parser)
+             document (.createSVGDocument df "" (java.io.ByteArrayInputStream. (.getBytes svg-str
+                                                                                java.nio.charset.StandardCharsets/UTF_8)))]
+         (.setSVGDocument s document)
+         (doto (.getContentPane f)
+           (.add s))
+         (doto f
+           (.pack)
+           (.setVisible true)))))))

 (defn new-svg-canvas []
   (org.apache.batik.swing.JSVGCanvas.))
@@ -54,6 +72,3 @@
                                               ""
                                               (java.io.ByteArrayInputStream. (.getBytes svg-str
                                                                                java.nio.charset.StandardCharsets/UTF_8))))))))
-
-(defn main []
-  (javax.swing.SwingUtilities/invokeLater hello-world))


swith window fix

swith window fix

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -229,13 +229,24 @@
     nil resp
     (:value resp)))

-(defn switch-window
+(defmulti switch-window
   "Switches a browser to another window."
   {:arglists '([driver handle])}
+  dispatch-driver)
+
+(defmethod switch-window
+  :default
   [driver handle]
   (with-resp driver :post
     [:session (:session @driver) :window]
     {:handle handle} _))
+
+(defmethods switch-window
+  [:chrome :headless]
+  [driver handle]
+  (with-resp driver :post
+    [:session (:session @driver) :window]
+    {:name handle} _))

 (defmulti close-window
   "Closes the current browser window."


Lets use /opt/opscode/embedded/bin, shall we?

--- src/fatty/core.clj
+++ src/fatty/core.clj
@@ -52,7 +52,7 @@
                             ["sudo" "make" "install"]]))

 (def chef (software :source "chef"
-            :steps [["/opt/embedded/bin/gems" "install" "chef" "-n" "/opt/opscode/bin"]]))
+            :steps [["/opt/opscode/embedded/bin/gems" "install" "chef" "-n" "/opt/opscode/bin"]]))

 (defn- log-sh-result
   [status true-log false-log]


Update the elasticsearch HQ link to the latest.

--- src/kiries/web.clj
+++ src/kiries/web.clj
@@ -38,7 +38,7 @@
   (route/resources "/kibana/" {:root "htdocs/kibana"})

   ;; Point to our bundled installation of ElasticSearch HQ
-  (route/resources "/HQ/" {:root "htdocs/royrusso-elasticsearch-HQ-c321806"})
+  (route/resources "/HQ/" {:root "htdocs/royrusso-elasticsearch-HQ-ea630c8"})

   (route/not-found "
Page not found
"))


Make browser-node function param optional

Now we don't have to pass a dummy value if we aren't planning on running
or application in the browser.

--- src/ktoa/core.cljs
+++ src/ktoa/core.cljs
@@ -29,15 +29,18 @@
   depending on current platform"
   (some-> modules :platform .-OS keyword))

-(defn register! [app-name mount node]
+(defn register!
   "If we have any app in registry - simply re-mount the app to the
    root node in order to reload it. If nothing exists yet - register
    in a usual way. If we are in a browser - mount to the browser node"
-  (if react-native
-    (if (seq (.getAppKeys (:registry modules)))
-      (mount react-native-root)
-      (.registerRunnable (:registry modules) app-name #(mount (aget % "rootTag"))))
-    (mount (node))))
+  ([app-name mount]
+   (register! app-name mount #()))
+  ([app-name mount browser-node]
+   (if react-native
+     (if (seq (.getAppKeys (:registry modules)))
+       (mount react-native-root)
+       (.registerRunnable (:registry modules) app-name #(mount (aget % "rootTag"))))
+     (mount (browser-node)))))

 (defn class [opt]
   "Creates React class"


cleanup cli arg parsing

cleanup cli arg parsing

--- src/mirror/cli.clj
+++ src/mirror/cli.clj
@@ -1,8 +1,12 @@
 (ns mirror.cli
   (:require [me.raynes.fs :as fs]
             [aleph.http :as http]
-            [mirror.middleware :refer (make-handler)])
+            [mirror.middleware :refer (make-handler)]
+            [mirror.core :as core])
   (:gen-class))
+
+(def known-flags
+  #{:watch})

 (defn check-if-files-exists [pages-path static-path]
   (when
@@ -10,11 +14,19 @@
              (fs/exists? static-path)))
     (throw (Exception. "cant find pages or static dirs"))))

+(defn check-if-flags-valid [flags])
+
 (defn cli-start [args]
   (println "cli" args)
-  (let [pages-path  (or (first args) "pages")
-        static-path (or (first args) "static")]
+  (let [parsed (map read-string args)
+        flags (set (filter keyword? parsed))
+        args (filter (complement keyword?) parsed)
+        watch? (contains? flags :watch)
+        pages-path  (or (some-> (first args) str) "pages")
+        static-path (or (some-> (second args) str) "static")]
+    (check-if-flags-valid flags)
     (check-if-files-exists pages-path static-path)
+    (when watch?  (core/watch-reload pages-path static-path))
     (let [port (or (System/getenv "PORT") 3000)]
       (println "starting server on port" port)
       (http/start-server


Scatter hot fix

Scatter hot fix

--- backend/src/akvo/lumen/lib/aggregation/commons.clj
+++ backend/src/akvo/lumen/lib/aggregation/commons.clj
@@ -13,12 +13,13 @@
     (:columnName column)))

 (defn sql-aggregation-subquery [aggregation-method column]
-  (let [v (cast-to-decimal column)]
-    (case aggregation-method
-      nil ""
-      ("min" "max" "count" "sum") (str aggregation-method "(" v "::decimal)")
-      "mean" (str "avg(" v "::decimal)")
-      "median" (str "percentile_cont(0.5) WITHIN GROUP (ORDER BY " v ")")
-      "distinct" (str "COUNT(DISTINCT " v ")")
-      "q1" (str "percentile_cont(0.25) WITHIN GROUP (ORDER BY " v ")")
-      "q3" (str "percentile_cont(0.75) WITHIN GROUP (ORDER BY " v ")"))))
+  (when column
+    (let [v (cast-to-decimal column)]
+      (case aggregation-method
+        nil ""
+        ("min" "max" "count" "sum") (str aggregation-method "(" v "::decimal)")
+        "mean" (str "avg(" v "::decimal)")
+        "median" (str "percentile_cont(0.5) WITHIN GROUP (ORDER BY " v ")")
+        "distinct" (str "COUNT(DISTINCT " v ")")
+        "q1" (str "percentile_cont(0.25) WITHIN GROUP (ORDER BY " v ")")
+        "q3" (str "percentile_cont(0.75) WITHIN GROUP (ORDER BY " v ")")))))


restore fix for auto-applying Failed filter

--- src-cljs/frontend/routes.cljs
+++ src-cljs/frontend/routes.cljs
@@ -196,15 +196,13 @@
     [short-vcs-type org repo build-num _ maybe-fragment]
     ;; normal destructuring for this broke the closure compiler
     (let [_fragment (:_fragment maybe-fragment)
-          {:keys [tab container-id action-id]} (parse-build-page-fragment _fragment)]
-      (open-to-inner! nav-ch :build {:vcs_type (vcs/->lengthen-vcs short-vcs-type)
-                                     :project-name (str org "/" repo)
-                                     :build-num (js/parseInt build-num)
-                                     :org org
-                                     :repo repo
-                                     :tab tab
-                                     :container-id container-id
-                                     :action-id action-id})))
+          fragment-args (parse-build-page-fragment _fragment)]
+      (open-to-inner! nav-ch :build (merge fragment-args
+                                           {:vcs_type (vcs/->lengthen-vcs short-vcs-type)
+                                            :project-name (str org "/" repo)
+                                            :build-num (js/parseInt build-num)
+                                            :org org
+                                            :repo repo}))))

   (defroute v1-project-settings #"/(gh|bb)/([^/]+)/([^/]+)/edit" [short-vcs-type org repo _ maybe-fragment]
     (open-to-inner! nav-ch :project-settings {:vcs_type (vcs/->lengthen-vcs short-vcs-type)


More work in fleshing out pclass-ctor handling.

Also handled Delay specially, when creating an htn task.

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -298,10 +298,34 @@
                          (dbg-println :trace "RPC name" name "method-arg"
                                       method-arg "pclass-arg" pclass-arg)
                          (or method-arg pclass-arg
-                             (if (or (= (:type caller_) :plant-fn-field)
-                                 (and (= (:type caller_) :plant-fn-symbol)
-                                      (= (:name caller_) 'this)))
+                             (if (= (:type caller_) :plant-fn-field)
                                (get-in ir [caller-pclass :fields (:field caller_) :initial]))
+                             (if (= name 'this)
+                               ;;Use the ancestry-path to resolve the pclass of the caller
+                               (let [parent-hem (nth ancestry-path 2)
+                                     parent-henpt (nth ancestry-path 3)
+                                     parent-hem-pclass (get-in parent-hem [:irks 0])
+                                     st 0
+                                     parent-subtask_ (get-in parent-hem [:subtasks st])]
+                                 ;; (dbg-println :debug "RPC this"
+                                 ;;              (with-out-str (pprint ancestry-path)))
+                                 ;; (dbg-println :debug "RPC parent-hem"
+                                 ;;              (with-out-str (pprint parent-hem))
+                                 ;;              "\nparent-henpt"
+                                 ;;              (with-out-str (pprint parent-henpt)))
+                                 (dbg-println :debug "RPC Recursing on ancestry-path"
+                                              (mapv #(list (:uid %) (or (:label %) (:name %)))
+                                                    ancestry-path))
+                                 ;; Tom: Note that parent-hem-pclass is nil
+                                 (dbg-println :debug "parent-hem-pclass" parent-hem-pclass)
+                                 ;; {:error :unresolved-pclass-ctor-need-ancestry-path}
+                                 (resolve-plant-class
+                                  ir parent-hem-pclass pargs parent-henpt parent-subtask_)
+                                 ))
+                             ;;In the case of this.methodname, we need to find the pclass-ctor
+                             ;; (if (and (= (:type caller_) :plant-fn-symbol)
+                             ;;          (= (:name caller_) 'this))
+                             ;;   )
                              {:error :unresolved-pclass-ctor}))

                        (= type :delay)
@@ -844,8 +868,8 @@
   (let [network-flows (if (network-flow-types name)
                         (make-network-flows name flow-characteristics arguments)
                         network-flows)]
-    (if-not pclass
-      (throw (Exception. (str "htn-task constructed w/o pclass: name" name))))
+    (if (and (not pclass) (not= name 'delay))
+      (throw (Exception. (str "htn-task constructed w/o pclass: name " name))))
     (update-htn-object!
      (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
                :type :htn-task


Added compojure route to index.html.

Added compojure route to index.html.

--- src/clj_formal_specifications_app/core.clj
+++ src/clj_formal_specifications_app/core.clj
@@ -1,10 +1,17 @@
 (ns clj-formal-specifications-app.core
   (:require [compojure.core :refer :all]
             [ring.middleware.defaults :refer :all]
+            [ring.util.response :as resp]
             [org.httpkit.server :refer [run-server]]))

-(defroutes all-routes
-  (GET "/" [] "Hello World"))
+(defn index
+  [req]
+  (resp/content-type
+    (resp/resource-response "index.html" {:root "public"})
+    "text/html"))
+
+(defroutes site-routes
+  (GET "/" [] index))

 (defn -main []
-  (run-server (wrap-defaults all-routes site-defaults) {:port 5000}))
+  (run-server (wrap-defaults site-routes site-defaults) {:port 5000}))


Add javadoc instruction

Add javadoc instruction

--- src/reply/main.clj
+++ src/reply/main.clj
@@ -44,9 +44,10 @@
   (set-signal-handler! "CONT" handle-resume)

   (println "Clojure" (clojure-version))
-  (println "Exit:   Control+D")
-  (println "Docs:   (doc function-name)")
-  (println "Source: (source function-name)")
+  (println "Exit:    Control+D")
+  (println "Docs:    (doc function-name)")
+  (println "Javadoc: (javadoc java-object-or-class)")
+  (println "Source:  (source function-name)")

   (with-redefs [clojure.core/print-sequential hacks.printing/print-sequential
                 complete/resolve-class hacks.complete/resolve-class]


Verify data

Verify data

--- src/clj_simple_chart/ncs/production_cumulative_yearly_fields.clj
+++ src/clj_simple_chart/ncs/production_cumulative_yearly_fields.clj
@@ -56,7 +56,10 @@
                     (map :prfYear)
                     (apply max)))

-(def field-names (map :prfInformationCarrier parsed))
+(def field-names (->> (map :prfInformationCarrier parsed)
+                      (distinct)
+                      (sort)
+                      (vec)))

 (defn cumulative-production
   [fields year kind]
@@ -76,5 +79,17 @@
                    (reduce + 0)
                    (double))))

+(test/is (= (Math/round 4650.93)
+            ; This value 4650.93 from
+            ; Sokkelåret 2016 Excel Sheet Figur 2-1
+            ; Summing column I (without forecast)
+            (Math/round (cumulative-production field-names 2016 :liquids))))
+
+(test/is (= (Math/round 2193.00)
+            ; This value 2193.00 (2188.14) from
+            ; Sokkelåret 2016 Excel Sheet Figur 2-1
+            ; Summing column G (without forecast)
+            (Math/round (cumulative-production field-names 2016 :gas))))
+
 (test/is (< (cumulative-production ["STATFJORD"] 1990 :prfPrdLiquidsNetMillSm3)
             (cumulative-production ["STATFJORD"] 2000 :prfPrdLiquidsNetMillSm3)))


periodic task needs to be in a future

periodic task needs to be in a future

--- src/spq/server.clj
+++ src/spq/server.clj
@@ -123,23 +123,24 @@

 (defn periodic-task
   [stop-periodic-task]
-  (when-not @stop-periodic-task
-    (try
-      (let [to-retry (->> @state
-                       :tasks
-                       (filter #(> (lib/minutes-ago (:nano-time (val %)))
-                                   (get (val %) :retry-timeout-minutes))))]
-        (when (seq to-retry)
-          (timbre/info "period task found" (count to-retry) "tasks to retry")
-          (->> to-retry (map val) (map :task) (map dq/retry!) dorun)
-          (swap! state #(reduce (fn [% [id {:keys [task]}]]
-                                  (-swap-retry % id task))
-                                %
-                                to-retry))))
-      (time/in (conf :server :period-millis) #(periodic-task stop-periodic-task))
-      (catch Throwable ex
-        (timbre/fatal ex "error in period task")
-        (lib/shutdown)))))
+  (future
+    (when-not @stop-periodic-task
+      (try
+        (let [to-retry (->> @state
+                         :tasks
+                         (filter #(> (lib/minutes-ago (:nano-time (val %)))
+                                     (get (val %) :retry-timeout-minutes))))]
+          (when (seq to-retry)
+            (timbre/info "period task found" (count to-retry) "tasks to retry")
+            (->> to-retry (map val) (map :task) (map dq/retry!) dorun)
+            (swap! state #(reduce (fn [% [id {:keys [task]}]]
+                                    (-swap-retry % id task))
+                                  %
+                                  to-retry))))
+        (time/in (conf :server :period-millis) #(periodic-task stop-periodic-task))
+        (catch Throwable ex
+          (timbre/fatal ex "error in period task")
+          (lib/shutdown))))))

 (defn main
   [port & {:keys [extra-handlers
@@ -168,7 +169,7 @@
                  (concat extra-handlers [(route/not-found "No such page.")])
                  (http/start! :port port :extra-middleware extra-middleware))]
     (time/in (conf :server :period-millis) #(periodic-task stop-periodic-task))
-    (fn close-fn []
+    (fn stop-fn []
       (reset! stop-periodic-task true)
       (.close server))))


move to bchain project

move to bchain project

--- src/bitcoinrpc/blockchain.clj
+++ src/bitcoinrpc/blockchain.clj
@@ -1,63 +0,0 @@
-(ns bitcoinrpc.blockchain
-  "Functions using the blockchain.info API"
-  (:require [clj-http.client :as client]
-            [clojure.data.json :as json])
-  )
-
-(defn blockchain-call [arg]
-  (let [res (client/get (format "https://blockchain.info/%s" arg))]
-    (if (= (:status res) 200)
-      (-> res :body json/read-str)
-      (throw (IllegalStateException. (pr-str res))))))
-
-
-(defn exchange-rates [] (blockchain-call "ticker"))
-
-(defn dollar-rate [] (((exchange-rates) "USD") "last"))
-
-(defn tobtc [value to-currency]
-  (blockchain-call (format "tobtc?currency=%s&value=%s" to-currency value)))
-
-(defn blockchain-query-call [arg] (blockchain-call (format "q/%s" arg)))
-
-(defmacro def-query [& args]
-  `(do
-     ~@(map (fn [a] `(defn ~a [] (blockchain-query-call ~(str a)))) args)))
-
-
-;realtime
-(def-query
-  getdifficulty
-  getblockcount
-  latesthash
-  bcperblock
-  totalbc
-  probability
-  hashestowin
-  nextretarget
-  avgtxsize
-  avgtxvalue
-  interval
-  eta
-  avgtxnumber)
-
-
-;misc
-
-(def-query
-  unconfirmedcount
-  marketcap
-  hashrate
-  rejected)
-
-
-
-
-(defn _24hrprice [] (blockchain-query-call "24hrprice"))
-(defn _24hrtransactioncount  [] (blockchain-query-call "24hrtransactioncount "))
-(defn _24hrbtcsent [] (blockchain-query-call "24hrbtcsent"))
-
-
-(defn block-of [height] (blockchain-call (format "block-height/%s?format=json" height)))
-
-(defn latest-block [] (blockchain-call "latestblock"))


add TODO comment

add TODO comment

--- src/braid/server/markdown.clj
+++ src/braid/server/markdown.clj
@@ -34,6 +34,8 @@
                               (vec (cons :div args)))
                          })))

+; TODO: this stuff should probably be in a different namespace - maybe just
+; under script/generate.clj or something?
 (defn generate-changelog
   []
   (let [changelog-hiccup (markdown->hiccup (slurp "CHANGELOG.md"))]


Added missing where clause

Added missing where clause

--- src/clj/salava/gallery/db.clj
+++ src/clj/salava/gallery/db.clj
@@ -7,11 +7,13 @@

 (defqueries "sql/gallery/queries.sql")

-(defn public-badges-by-user [ctx user-id]
+(defn public-badges-by-user
+  "Return user's public badges"
+  [ctx user-id]
   (select-users-public-badges {:user_id user-id} (get-db ctx)))

 (defn public-badges
-  "Returns badges visible in gallery"
+  "Return badges visible in gallery. Badges can be searched by country ID, badge name, issuer name or recipient's first or last name"
   [ctx country badge-name issuer-name recipient-name]
   (let [where ""
         params []
@@ -31,7 +33,9 @@
                     JOIN badge_content AS bc ON b.badge_content_id = bc.id
                     JOIN issuer_content AS ic ON b.issuer_content_id = ic.id
                     LEFT JOIN user AS u ON b.user_id = u.id
-                    WHERE b.status = 'accepted' AND b.deleted = 0 AND b.revoked = 0 AND (b.expires_on IS NULL OR b.expires_on > UNIX_TIMESTAMP()) AND b.visibility = 'public'GROUP BY bc.id
+                    WHERE b.status = 'accepted' AND b.deleted = 0 AND b.revoked = 0 AND (b.expires_on IS NULL OR b.expires_on > UNIX_TIMESTAMP()) AND b.visibility = 'public' "
+                   where
+                   " GROUP BY bc.id
                     ORDER BY b.ctime DESC
                     LIMIT 100")]
     (jdbc/with-db-connection
@@ -39,16 +43,17 @@
       (jdbc/query conn (into [query] params)))))

 (defn user-country
-  "Get user's country"
+  "Return user's country id"
   [ctx user-id]
   (select-user-country {:id user-id} (into {:row-fn :country :result-set-fn first} (get-db ctx))))

 (defn all-badge-countries [ctx]
+  "Return all countries which users have public badges"
   (let [country-keys (select-badge-countries {} (into {:row-fn :country} (get-db ctx)))]
     (select-keys all-countries country-keys)))

 (defn badge-countries
-  ""
+  "Return user's country id and list of all countries which users have public badges"
   [ctx user-id]
   (let [current-country (user-country ctx user-id)
         countries (merge (all-badge-countries ctx) (select-keys all-countries [current-country]))]


fix element ids for list items

fix element ids for list items

--- src/cljs/clj_money/forms.cljs
+++ src/cljs/clj_money/forms.cljs
@@ -72,7 +72,10 @@
                                (reset! options (list-fn doc)))
                    :on-change #(save! (:id attr) (value-of %))
                    :name (:id attr)}]
-    (render-element attr doc [tag elem-attr
-                              (for [[display id] @options]
-                                ^{:key (str "list-option-" (:id attr) "-" id)}
-                                [:option {:value id} display])])))
+    (render-element attr
+                    doc
+                    [tag
+                     elem-attr
+                     (for [[display id] @options]
+                       (with-meta [:option {:value id} display]
+                                  {:key (str "list-option-" (:id attr) "-" id)}))])))


Improve text

Improve text

--- src/cljs/rfcdothelp/core.cljs
+++ src/cljs/rfcdothelp/core.cljs
@@ -66,7 +66,8 @@
             {:on-click set-rfc!}
             "acquire happies"]
        :error [:div
-               "<rfc.help> i am so sorry :( have this instead:"
+               (str "<rfc.help> i am so sorry :( i can't find an appropriate "
+                    "replacement but have this instead:")
                [:img {:src unikitty}]]
        [:div
         "<rfc.help> i am so sorry :( wouldn't you rather have this:"


Refactor template a bit

Refactor template a bit

--- src/cloact/impl/template.cljs
+++ src/cloact/impl/template.cljs
@@ -2,26 +2,26 @@
 (ns cloact.impl.template
   (:require-macros [cloact.debug :refer [dbg prn println]])
   (:require [clojure.string :as string]
-            [cloact.impl.reactimport :as reacts]
+            [cloact.impl.reactimport :as reactimport]
             [cloact.impl.util :as util]))

-(def React reacts/React)
+(def React reactimport/React)

 (def isClient (not (nil? (try (.-document js/window)
                               (catch js/Object e nil)))))

 (defn dash-to-camel [dashed]
-  (let [words (string/split (name dashed) #"-")
-        camels (map string/capitalize (rest words))]
-    (apply str (first words) camels)))
+  (let [words (-> dashed name (string/split #"-"))]
+    (apply str (first words)
+           (->> words rest (map string/capitalize)))))

-(def attr-aliases {"class" "className"
-                   "for" "htmlFor"
-                   "charset" "charSet"})
+(def attr-aliases {:class "className"
+                   :for "htmlFor"
+                   :charset "charSet"})

 (defn undash-prop-name [n]
-  (let [undashed (dash-to-camel n)]
-    (get attr-aliases undashed undashed)))
+  (or (attr-aliases n)
+      (dash-to-camel n)))

 (def cached-prop-name (memoize undash-prop-name))
 (def cached-style-name (memoize dash-to-camel))
@@ -34,47 +34,44 @@
         (ifn? val) (fn [& args] (apply val args))
         :else (clj->js val)))

-(defn set-tag-extra [props [id class]]
-  (set! (.-id props) id)
+(defn set-id-class [props [id class]]
+  (aset props "id" id)
   (when class
-    (set! (.-className props)
-          (if-let [old (.-className props)]
-            (str class " " old)
-            class))))
+    (aset props "className" (if-let [old (aget props "className")]
+                              (str class " " old)
+                              class))))

-(defn convert-props [props extra]
+(defn convert-props [props id-class]
   (let [is-empty (empty? props)]
     (cond
-     (and is-empty (nil? extra)) nil
+     (and is-empty (nil? id-class)) nil
      (identical? (type props) js/Object) props
      :else (let [objprops (js-obj)]
              (when-not is-empty
                (doseq [[k v] props]
                  (aset objprops (cached-prop-name k)
                        (convert-prop-value v))))
-             (when-not (nil? extra)
-               (set-tag-extra objprops extra))
+             (when-not (nil? id-class)
+               (set-id-class objprops id-class))
              objprops))))

 (defn map-into-array [f coll]
-  (let [a (into-array coll)
-        len (alength a)]
-    (dotimes [i len]
+  (let [a (into-array coll)]
+    (dotimes [i (alength a)]
       (aset a i (f (aget a i))))
     a))

 (declare as-component)

-(defn wrapped-render [this comp extra]
+(defn wrapped-render [this comp id-class]
   (let [inprops (aget this "props")
         args (.-cljsArgs inprops)
-        [_ scnd] args
-        hasprops (or (nil? scnd) (map? scnd))
-        jsprops (convert-props (if hasprops scnd) extra)
-        jsargs (->> args
-                    (drop (if hasprops 2 1))
+        props (nth args 1 nil)
+        hasprops (or (nil? props) (map? props))
+        jsargs (->> (if hasprops (drop 1 args) args)
                     (map-into-array as-component))]
-    (.apply comp nil (.concat (array jsprops) jsargs))))
+    (aset jsargs 0 (convert-props (if hasprops props) id-class))
+    (.apply comp nil jsargs)))

 (defn wrapped-should-update [C nextprops nextstate]
   (let [a1 (-> C (aget "props") .-cljsArgs)
@@ -82,16 +79,14 @@
     (not (util/equal-args a1 a2))))

 (defn wrap-component [comp extras]
-  (let [spec #js {:render #(this-as C (wrapped-render C comp extras))
-                  :shouldComponentUpdate
-                  #(this-as C (wrapped-should-update C %1 %2))}]
-    (.createClass React spec)))
+  (.createClass React (js-obj "render"
+                              #(this-as C (wrapped-render C comp extras))
+                              "shouldComponentUpdate"
+                              #(this-as C (wrapped-should-update C %1 %2)))))

 ;; From Weavejester's Hiccup, via pump:
-;; https://github.com/weavejester/hiccup/blob/master/src/hiccup/compiler.clj#L32
 (def ^{:doc "Regular expression that parses a CSS-style id and class
-             from a tag name."
-       :private true}
+             from a tag name."}
   re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

 (def DOM (aget React "DOM"))
@@ -101,17 +96,17 @@
         comp (aget DOM tag)
         class' (when class
                  (string/replace class #"\." " "))]
+    (assert comp (str "Unknown tag: " tag))
     [comp (when (or id class')
             [id class'])]))

 (defn get-wrapper [tag]
-  (let [[comp extra] (parse-tag tag)]
-    (wrap-component comp extra)))
+  (let [[comp id-class] (parse-tag tag)]
+    (wrap-component comp id-class)))

 (def cached-wrapper (memoize get-wrapper))

 (defn fn-to-class [f]
-  (assert (fn? f))
   (let [spec (meta f)
         withrender (merge spec {:render f})
         res (cloact.core/create-class withrender)
@@ -119,26 +114,29 @@
     (set! (.-cljsReactClass f) wrapf)
     wrapf))

-(defn as-class [x]
-  (cond
-   (keyword? x) (cached-wrapper x)
-   (not (nil? (.-cljsReactClass x))) (.-cljsReactClass x)
-   :else (do (assert (fn? x))
-             (if (.isValidClass React x)
-               (set! (.-cljsReactClass x) (wrap-component x nil))
-               (fn-to-class x)))))
+(defn as-class [tag]
+  (if (keyword? tag)
+    (cached-wrapper tag)
+    (do
+      (assert (fn? tag))
+      (let [cached-class (.-cljsReactClass tag)]
+        (if-not (nil? cached-class)
+          cached-class
+          (if (.isValidClass React tag)
+            (set! (.-cljsReactClass tag) (wrap-component tag nil))
+            (fn-to-class tag)))))))

 (defn vec-to-comp [v]
   (assert (pos? (count v)))
   (let [[tag props] v
         c (as-class tag)
-        obj (js-obj)]
-    (set! (.-cljsArgs obj) v)
+        jsprops (js-obj)]
+    (set! (.-cljsArgs jsprops) v)
     (when (map? props)
       (let [key (:key props)]
         (when-not (nil? key)
-          (set! (.-key obj) key))))
-    (c obj)))
+          (aset jsprops "key" key))))
+    (c jsprops)))

 (defn as-component [x]
   (cond (vector? x) (vec-to-comp x)


cljr clean namespace

cljr clean namespace

The formatting isn't great but it's not a big deal

--- src/tick/core.cljc
+++ src/tick/core.cljc
@@ -6,7 +6,7 @@
     [clojure.spec.alpha :as s]
     [clojure.string :as str]
     [tick.interop :as t.i]
-    #?(:cljs
+    #?(:cljs
        [tick.js-joda :refer [Date Clock ZoneId ZoneOffset Instant Duration Period DayOfWeek Month ZonedDateTime LocalTime LocalDateTime LocalDate Year YearMonth ZoneId OffsetDateTime OffsetTime ChronoUnit ChronoField TemporalAdjusters]]))
   #?(:clj
      (:import
@@ -149,7 +149,7 @@
   (int [v] (#?(:clj clojure.core/int :cljs parse-int)  v))
   (long [v] (#?(:clj clojure.core/long :cljs parse-int) v))

-  #?(:clj clojure.lang.Fn :cljs function)
+  #?(:clj clojure.lang.Fn :cljs function)
   (date [f] (date (f)))
   (time [f] (time (f)))
   (day [f] (day (f)))
@@ -488,9 +488,9 @@
   (> [x y] (.isAfter x y))
   (>= [x y] (not (.isBefore x y))))

-#?(:cljs
-   (extend-protocol IComparable
-     Instant
+#?(:cljs
+   (extend-protocol IComparable
+     Instant
      (-compare [x y] (.compareTo x y))
      LocalDateTime
      (-compare [x y] (.compareTo x y))
@@ -654,7 +654,7 @@
   ZoneId
   (clock [z] (. Clock system z))

-  #?(:clj String :cljs string)
+  #?(:clj String :cljs string)
   (clock [s] (clock (parse s))))

 (defn advance
@@ -675,7 +675,7 @@
 ;; Atomic clocks :)

 (defrecord AtomicClock [*clock]
-  #?(:clj clojure.lang.IDeref :cljs IDeref)
+  #?(:clj clojure.lang.IDeref :cljs IDeref)
   (#?(:clj deref :cljs -deref) [_] (instant @*clock))
   IClock
   (clock [_] @*clock))
@@ -867,7 +867,7 @@
        (divide-duration [n duration] (.dividedBy duration n))
        Duration
        (divide-duration [divisor duration]
-          #?(:clj (clojure.core// (t.i/getter seconds duration) (t.i/getter seconds divisor))
+          #?(:clj (clojure.core// (t.i/getter seconds duration) (t.i/getter seconds divisor))
              :cljs (cljs.core// (.seconds duration) (.seconds divisor))) ))

 (extend-type Duration


Changed the xml output to be non-indented.

--- src/cmr/common/api/errors.clj
+++ src/cmr/common/api/errors.clj
@@ -17,7 +17,7 @@
   [errors xml-format?]
   (let [content-type (if xml-format? "application/xml" "application/json")
         body (if xml-format?
-               (x/indent-str
+               (x/emit-str
                  (x/element :errors {}
                             (for [err errors]
                               (x/element :error {} err))))


Added Earth-centered Earth-fixed conversion functions.


Proper use of common files on index page

--- src/arachnida/html_renderer.clj
+++ src/arachnida/html_renderer.clj
@@ -1,8 +1,10 @@
 (ns arachnida.html-renderer)

-(require '[hiccup.core                   :as hiccup])
-(require '[hiccup.page                   :as page])
-(require '[hiccup.form                   :as form])
+(require '[hiccup.core         :as hiccup])
+(require '[hiccup.page         :as page])
+(require '[hiccup.form         :as form])
+
+(require '[arachnida.config    :as config])

 (defn render-html-header
     "Renders part of HTML page - the header."
@@ -12,14 +14,13 @@
         [:meta {:name "Author"    :content "Pavel Tisnovsky"}]
         [:meta {:name "Generator" :content "Clojure"}]
         [:meta {:http-equiv "Content-type" :content "text/html; charset=utf-8"}]
-        (page/include-css "bootstrap.min.css")
-        (page/include-css "bootstrap.min.css")
-        (page/include-css "arachnida.css")
-        (page/include-js  "bootstrap.min.js")
-        (page/include-js  "flotr/lib/prototype-1.6.0.2.js")
-        (page/include-js  "flotr/lib/canvas2image.js")
-        (page/include-js  "flotr/lib/canvastext.js")
-        (page/include-js  "flotr/flotr.debug-0.2.0-alpha.js")
+        (page/include-css (str @config/url-to-common-files "bootstrap.min.css"))
+        (page/include-css (str @config/url-to-common-files "arachnida.css"))
+        (page/include-js  (str @config/url-to-common-files "bootstrap.min.js"))
+        (page/include-js  (str @config/url-to-common-files "flotr/lib/prototype-1.6.0.2.js"))
+        (page/include-js  (str @config/url-to-common-files "flotr/lib/canvas2image.js"))
+        (page/include-js  (str @config/url-to-common-files "flotr/lib/canvastext.js"))
+        (page/include-js  (str @config/url-to-common-files "flotr/flotr.debug-0.2.0-alpha.js"))
     ] ; head
 )

@@ -77,3 +78,48 @@
         ] ; </body>
     ))

+(defn render-product-page
+    [product-name repositories]
+    (page/xhtml
+        (render-html-header)
+        [:body
+            [:div {:class "container"}
+                (render-navigation-bar-section)
+                [:h1 (str "Product: " product-name)]
+                [:table {:class "table table-condensed table-hover table-bordered" :rules "all"}
+                    (for [repository repositories]
+                        [:tr
+                            [:td (:name repository)]
+                            [:td (:url repository)]])
+                ]
+                [:br][:br][:br][:br]
+                (render-html-footer)
+            ] ; </div class="container">
+        ] ; </body>
+    ))
+
+(defn render-author-page
+    [author-name statistic]
+    (page/xhtml
+        (render-html-header)
+        [:body
+            [:div {:class "container"}
+                (render-navigation-bar-section)
+                [:h1 (str "Author: " author-name)]
+                [:table {:class "table table-condensed table-hover table-bordered" :rules "all"}
+                    [:tr [:th {:colspan 2} "Summary for 2015"]]
+                    [:tr [:td "Commits:"]
+                         [:td (:commits_count statistic)]]
+                    [:tr [:td "Insertions:"]
+                         [:td (:insertions statistic)]]
+                    [:tr [:td "Deletions:"]
+                         [:td (:deletions statistic)]]
+                    [:tr [:td "Changed files:"]
+                         [:td (:files_changed statistic)]]
+                ]
+                [:br][:br][:br][:br]
+                (render-html-footer)
+            ] ; </div class="container">
+        ] ; </body>
+    ))
+


attributes of dom element in top level map and pull css properties into :css key

--- src/com/kaicode/infamous.cljs
+++ src/com/kaicode/infamous.cljs
@@ -98,10 +98,16 @@
                                       options (clj->js {:tagName tag-name})]
                                      (component-constructor. famous-node options))
                                 (component-constructor. famous-node))
-                    properties (dissoc component-descriptor :component/type :db/id)]
-                   (doseq [p properties
-                           :let [name (name (first p))
-                                 value (second p)]]
+                    css (:css component-descriptor)
+                    attributes (dissoc component-descriptor :component/type :db/id :tag-name :css)]
+                   (doseq [c css
+                           :let [name (name (first c))
+                                 value (second c)]]
+                          (.. component (setProperty name value)))
+
+                   (doseq [a attributes
+                           :let [name (name (first a))
+                                 value (second a)]]
                           (cond
                             (= name "content") (.. component (setContent value))
                             (= name "id") (do (.. component (setId value)))
@@ -109,14 +115,13 @@
                                                       (.. component (addClass clz)))
                             (= name "depth") (.. component (setDepth value))
                             :else (do
-                                    (.. component (setProperty name value)))))
+                                    (.. component (setAttribute name value))))
+
+                          )
                    component)
               (let [component (clj->js component-descriptor)]
                    (.. famous-node (addComponent component))
                    component))))
-
-
-

 (defn- attach-famous-node-to-scene-graph [node]
        (let [famous-node (Node.)


cleanup whitespace

cleanup whitespace

--- src/babel/francais/lexicon.cljc
+++ src/babel/francais/lexicon.cljc
@@ -88,7 +88,6 @@
                                    (morph/exception-generator lexicon)))]
         (apply merge-with concat
                [exceptions lexicon]))))
-

    (default {:synsem {:cat :verb}
              :d-verb-reg-present true


(:morph) requires 3 arguments

(:morph) requires 3 arguments

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -664,7 +664,7 @@
                                  (morph-walk-tree tree))))
      :language "it"
      :language-keyword :italiano
-     :morph fo
+     :morph (fn [expression & {:keys [from-language show-notes]}] (fo expression))
      :morph-ps fo-ps
      :enrich enrich
      :generate {:lexicon lexicon-for-generation}


improve logging

improve logging

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -481,7 +481,8 @@
                               vocab-cat :vocab_cat
                               structure :structure}]
   (log/info (str "calling vocab-entry-to-lexeme with "
-                 "surface=" surface " and structure=" structure))
+                 "surface=" surface "; structure=" structure
+                 "; vocab-cat=" vocab-cat))
   (let [structure (or structure :top)
         debug (log/debug (str "structure (pre-dissoc): " structure))
         structure (if (= "" (dag_unify.core/get-in structure [:italiano :plur]))


--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -285,6 +285,12 @@
                                 :sem object-semantics}
                             :2 '()}
                    :sem {:obj object-semantics}}}))
+
+      ;; a preposition's object cannot be a reflexive pronoun.
+      (default
+       {:synsem {:cat :prep
+                 :subcat {:1 {:reflexive false}}}})
+
       ;; </preposition default rules>

       ;; <adjective default rules>


clean up old :refers

clean up old :refers

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -4,7 +4,7 @@
   (:require
    [babel.lexicon :refer [universals]]
    [babel.encyclopedia :as encyc]
-   [babel.lexiconfn :refer [compile-lex if-has if-then default
+   [babel.lexiconfn :refer [default
                             filter-vals listify map-function-on-map-vals
                             new-entries rewrite-keys verb-pred-defaults
                             ;; TODO: use dag_unify/unifyc instead:


Fix #67 Check that WebDAV mount succeeds

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -249,12 +249,14 @@
   {:pre [(map? repl-env) (is-ambly-bonjour-name? bonjour-name)
          (string? endpoint-address) (number? endpoint-port)]}
   (let [webdav-mount-point (str "/Volumes/Ambly-" (format "%08X" (hash bonjour-name)))
-        output-dir (io/file webdav-mount-point)]
+        output-dir (io/file webdav-mount-point)
+        webdav-endpoint (str "http://" endpoint-address ":" endpoint-port)]
     (when (.exists output-dir)
       (sh "umount" webdav-mount-point))
     (.mkdirs output-dir)
-    (sh "mount_webdav" (str "http://" endpoint-address ":" endpoint-port) webdav-mount-point)
-    (reset! (:webdav-mount-point repl-env) webdav-mount-point)
+    (if (zero? (sh "mount_webdav" webdav-endpoint webdav-mount-point))
+      (reset! (:webdav-mount-point repl-env) webdav-mount-point)
+      (throw (Exception. (str "Unable to mount WebDAV at " webdav-endpoint))))
     webdav-mount-point))

 (defn- set-up-socket


migrated to spec

migrated to spec

--- src/corpus_utils/document.clj
+++ src/corpus_utils/document.clj
@@ -1,69 +1,66 @@
 (ns corpus-utils.document
-  (:require [schema.core :as s]))
+  (:require [clojure.spec.alpha :as s]))

-(def opt s/optional-key)
+;; Required minimal metadata
+(s/def :metadata/title string?)
+(s/def :metadata/author string?)
+(s/def :metadata/year int?)
+(s/def :metadata/basename string?)
+(s/def :metadata/category (s/coll-of string?))
+(s/def :metadata/permission boolean?)

-(def BCCWJAnnotationSchema
-  {(opt :forward-or-afterward) Boolean
-   (opt :dialog)               Boolean
-   (opt :quotation-type)       Boolean
-   (opt :visual)               Boolean
-   (opt :db-or-list)           Boolean
-   (opt :archaic)              Boolean
-   (opt :foreign-language)     Boolean
-   (opt :math-or-code)         Boolean
-   (opt :legalese)             Boolean
-   (opt :questionable-content) Boolean
-   (opt :low-content)          Boolean
-   (opt :target-audience)      (s/enum 1 2 3 4 5)
-   (opt :hard-soft)            (s/enum 1 2 3 4)
-   (opt :informality)          (s/enum 1 2 3)
-   (opt :addressing)           (s/enum 1 2 3)
-   (opt :protagonist-personal-pronoun) s/Str
-   (opt :other-addressing)     (s/enum 1 2 3 4)})
+;; BCCWJ metadata
+(s/def :metadata/gender #{:male :female :mixed})
+(s/def :metadata/author-year int?)
+(s/def :metadata/publisher string?)
+(s/def :metadata/copyright string?)
+(s/def :metadata/audience string?)
+(s/def :metadata/media string?)
+(s/def :metadata/topic string?)
+(s/def :metadata/corpus string?)
+(s/def :metadata/subcorpus string?)
+(s/def :metadata/script string?)

-(def MetadataSchema
-  "Schema of a document's possible metadata"
-  (merge BCCWJAnnotationSchema
-         {:title     s/Str
-          :author    s/Str
-          (opt :gender) (s/enum :male :female :mixed)
-          (opt :author-year) s/Int
-          :publisher s/Str
-          (opt :copyright) s/Str
-          (opt :audience) s/Str
-          (opt :media) s/Str
-          (opt :topic) s/Str
-          :year      s/Int
-          :basename  s/Str
-          :corpus    s/Str
-          (opt :script) s/Str
-          (opt :subcorpus) s/Str
-          :category  [s/Str]}))
+;; BCCWJ extra annotations
+(s/def :metadata/forward-or-afterward boolean?)
+(s/def :metadata/dialog boolean?)
+(s/def :metadata/quotation-type boolean?)
+(s/def :metadata/visual boolean?)
+(s/def :metadata/db-or-list boolean?)
+(s/def :metadata/archaic boolean?)
+(s/def :metadata/foreign-language boolean?)
+(s/def :metadata/math-or-code boolean?)
+(s/def :metadata/legalese boolean?)
+(s/def :metadata/questionable-content boolean?)
+(s/def :metadata/low-content boolean?)
+(s/def :metadata/target-audience #{1 2 3 4 5})
+(s/def :metadata/hard-soft #{1 2 3 4})
+(s/def :metadata/informality #{1 2 3})
+(s/def :metadata/addressing #{1 2 3})
+(s/def :metadata/protagonist-personal-pronoun string?)
+(s/def :metadata/other-addressing #{1 2 3 4})

-(def SentencesSchema
-  [{:tags clojure.lang.PersistentHashSet
-    :sentences [s/Str]}])
+(s/def :document/metadata
+  (s/keys :req
+          [:metadata/title :metadata/author :metadata/year :metadata/basename
+           :metadata/category :metadata/permission]
+          :opt
+          [:metadata/gender :metadata/author-year :metadata/publisher :metadata/copyright
+           :metadata/audience :metadata/media :metadata/topic
+           :metadata/corpus :metadata/subcorpus :metadata/script

-(def DocumentSchema
-  {:paragraphs SentencesSchema
-   :metadata   MetadataSchema})
+           :metadata/forward-or-afterward :metadata/dialog :metadata/quotation-type :metadata/visual
+           :metadata/db-or-list :metadata/archaic :metadata/foreign-language :metadata/math-or-code
+           :metadata/legalese :metadata/questionable-content :metadata/low-content :metadata/target-audience
+           :metadata/hard-soft :metadata/informality :metadata/addressing :metadata/protagonist-personal-pronoun
+           :metadata/other-addressing]))

-(def UnidicMorphemeSchema
-  {:pos-1 s/Str
-   :pos-2 s/Str
-   :pos-3 s/Str
-   :pos-4 s/Str
-   :c-type s/Str
-   :c-form s/Str
-   :l-form s/Str
-   :lemma s/Str
-   :orth s/Str
-   :pron s/Str
-   :orth-base s/Str
-   :pron-base s/Str
-   :goshu s/Str
-   :i-type s/Str
-   :i-form s/Str
-   :f-type s/Str
-   :f-form s/Str})
+(s/def :sentence/text string?)
+(s/def :paragraph/sentences (s/coll-of :sentence/text))
+(s/def :paragraph/tags (s/coll-of keyword?))
+(s/def :document/paragraph (s/keys :req [:paragraph/tags :paragraph/sentences]))
+(s/def :document/paragraphs (s/coll-of :document/paragraph))
+(s/def :corpus/document (s/keys :req [:document/paragraphs]
+                                ;; FIXME Optional :basename at top level for documents with external metadata.
+                                :opt [:document/metadata :document/basename]))
+(s/def :corpus/documents (s/coll-of :corpus/document))


Finish the img api endpoint

Finish the img api endpoint

--- src/clj/comic_reader/server.clj
+++ src/clj/comic_reader/server.clj
@@ -77,9 +77,10 @@
         request
       (get-comic-imgs request))

-    (c/POST "/img" {{:keys [url]} :edn-params
+    (c/POST "/img" {{:keys [site page-url]} :edn-params
                     :as request}
-      (if-let [img-tag nil]
+      (if-let [img-tag (scrape/fetch-image-tag
+                        (sites/image-data site page-url))]
         (edn-response img-tag)
         (edn-response (gen-error-data request) 404))))


Added preconditions to simplify deseasonalization

--- src/clj/forma/trends/filter.clj
+++ src/clj/forma/trends/filter.clj
@@ -24,21 +24,23 @@
   only the trend component and the idiosyncratic disturbance of the
   original time series.

-  Precondition avoids singular matrix when `ts` is shorter than `freq`.
+  Precondition avoids singular matrix by throwing exception
+  when `ts` is shorter than `freq`. Throws an exception - due to meaningless
+  results - if `freq` equals 1 or in case we see `nil` as the `ts`.

   Example:
     (deseasonalize 23 (s/sample-uniform 200))"
   [freq ts]
-  {:pre [(>= (count ts) freq)]}
-  (if (nil? ts)
-    nil
-    (let [x (dummy-mat freq (i/nrow ts))
+  {:pre [(>= (count ts) freq)
+         (when nil? ts)
+         (< 1 freq)]}
+  (let [x (dummy-mat freq (i/nrow ts))
           xt (i/trans x)
           xtx (i/mmult xt x)
           coefs (i/mmult (i/solve xtx) xt ts)
           fitted (i/mmult x coefs)]
       (i/to-vect (i/plus (i/minus ts fitted)
-                         (s/mean ts))))))
+                         (s/mean ts)))))

 ;; Remove seasonal component by harmonic decomposition


Function to detect word existence

Function to detect word existence

--- src/clj_mrazik/db_interface.clj
+++ src/clj_mrazik/db_interface.clj
@@ -49,13 +49,14 @@

 (defn select-words
     [word]
-    (jdbc/query db-spec
+    (jdbc/query db-spec/mrazik-db
         ["select * from dictionary where term=?" word]))

 (defn select-word-count
     [word]
     (->
-        (jdbc/query db-spec
-            ["select count(*) from dictionary where term=?" word]
-            first)))
+        (jdbc/query db-spec/mrazik-db
+            ["select count(*) as cnt from dictionary where term=?" word])
+        first
+        :cnt))


Eliminate unneeded function in eager-fetch.

--- src/clj_record/associations.clj
+++ src/clj_record/associations.clj
@@ -5,8 +5,7 @@

 (defn eager-fetch [model-name foreign-key attribute-name records]
   (let [fetched-records (core/find-records model-name
-                                           {foreign-key (apply q/in (map (fn [record] (:id record))
-                                                                         records))})]
+                                           {foreign-key (apply q/in (map :id records))})]
     (map (fn [record]
            (conj {attribute-name (filter (fn [fetched]
                                            (= (:id record) (foreign-key fetched))) fetched-records)}


adding editing page

adding editing page

--- src/cljs/secret_shame/core.cljs
+++ src/cljs/secret_shame/core.cljs
@@ -13,8 +13,7 @@
             [cljs.reader :as reader :refer [read-string]]
             [cljs.core.async :refer [put! <! >! chan timeout]]
             [reagent.core :refer [atom] :as reagent]
-            [secretary.core :as secretary
-             :include-macros true :refer [defroute]]
+            [secretary.core :as secretary :include-macros true :refer [defroute]]
             [cljs-http.client :as http]))

 (enable-console-print!)
@@ -30,6 +29,29 @@

     c))

+(defn widget-edit "widget pane"
+  [id]
+
+  [:div.col.col-xs-12.col-md-12.bootcards-cards
+   [:div.panel.panel-default
+    [:div.panel-heading.clearfix
+     [:h3.panel-title.pull-left "Widget Card Editing: The Quantum Thief"]]
+    [:div.list-group
+     [:div.list-group.item
+      [:p.list-group-item-text "Name"]
+      [:h4.list-group-item-heading "Jean Leflambeur"]]
+     [:div.list-group.item
+      [:p.list-group-item-text "Occupation"]
+      [:h4.list-group-item-heading "Thief"]]
+     [:div.list-group.item
+      [:p.list-group-item-text
+       "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nullam
+      mauris tellus, vehicula ut tellus id, suscipit dapibus tortor.
+      Integer viverra turpis ac fringilla hendrerit. Sed faucibus
+      posuere felis et pe."]]]
+    [:div.panel-footer
+     [:small "Take a card, any card"]]]])
+
 (defn widget-view "widget pane"
   [id]

@@ -37,7 +59,7 @@
    [:div.panel.panel-default
     [:div.panel-heading.clearfix
      [:h3.panel-title.pull-left "Widget Card Title: The Quantum Thief"]
-     [:a.btn.btn-primary.pull-right {:href "#"}
+     [:a.btn.btn-primary.pull-right {:href (str "#/edit/" id)}
       [:i.fa.fa-pencil] "Edit"]]
     [:div.list-group
      [:div.list-group.item


Add a city selector component.

Add a city selector component.

--- src/cljs/weather_demo/core.cljs
+++ src/cljs/weather_demo/core.cljs
@@ -7,6 +7,10 @@
               [reagent-forms.core :refer [bind-fields]]
               [ajax.core :refer [GET json-response-format]]
               [clojure.string :as string]))
+
+(def app-state (atom {}))
+(def cities (reagent/cursor app-state [:cities]))
+(def city-id (reagent/cursor app-state [:city :id]))

 ;; -------------------------
 ;; Views
@@ -32,6 +36,26 @@
     (let [country (first (filter #(= (:cca2 %) country-id) countries))]
       [:p "Selected country is " (country-name country)])))

+(defn city-selector [cities]
+  [:select {:field :list :id :city.id}
+   (for [city (sort-by :name cities)]
+     [:option {:key (:_id city)} (:name city)])])
+
+(defn city-field []
+  (println "Rendering city field for" (count @cities) "cities")
+  (if-not @cities [:select [:option "Loading cities..."]]
+    [bind-fields (city-selector @cities) app-state]))
+
+(defn load-city-field [country-id]
+  (when country-id
+    (reset! cities nil)
+    (reset! city-id nil)
+    (println "Loading cities for" country-id)
+    (GET (str "/api/cities/" country-id)
+      {:handler #(reset! cities %)
+       :response-format (json-response-format {:keywords? true})}))
+  [city-field])
+
 (defn home-page []
   [:div [:h2 "Welcome to weather-demo"]
    [:div "You might want to check out the " [:a {:href "/weather"} "weather"]]])
@@ -45,6 +69,7 @@
     (fn []
       [:div [:h2 "Weather page"]
        [country-field @countries selected-country]
+       [load-city-field (:id @selected-country)]
        [country-description @countries (:id @selected-country)]])))

 (defn current-page []


Disable static-exchange-evaluation in cljs.

--- src/clojure/clj_chess/core.cljc
+++ src/clojure/clj_chess/core.cljc
@@ -384,12 +384,13 @@
   (b/variation-to-san board uci-moves
                       :include-move-numbers include-move-numbers))

-(defn static-exchange-evaluation
-  "Statically evaluates the material gain or loss of a move. The return
+#?(:clj
+   (defn static-exchange-evaluation
+     "Statically evaluates the material gain or loss of a move. The return
   value is a number of pawns, using a material scale of pawn = 1,
   knight = 3, bishop = 3, rook = 5, queen = 9."
-  [board move]
-  (b/static-exchange-evaluation board move))
+     [board move]
+     (b/static-exchange-evaluation board move)))

 (defn new-game
   "Creates a new game object with the given PGN tags and start position. The
@@ -759,4 +760,4 @@
      is neither \".pgn\", \".PGN\", \".ecn\" nor \".ECN\", PGN format is
      assumed."
      [file-name & {:keys [format]}]
-     (g/games-in-file file-name :format format)))+     (g/games-in-file file-name :format format)))


Add ImageView to default widgets

Add ImageView to default widgets

--- src/clojure/neko/ui/mapping.clj
+++ src/clojure/neko/ui/mapping.clj
@@ -15,7 +15,8 @@
   elements and the values for the keywords representing values."
   (:require [clojure.string :as string])
   (:use [neko.-utils :only [keyword->static-field reflect-field]])
-  (:import [android.widget LinearLayout Button EditText ListView SearchView]
+  (:import [android.widget LinearLayout Button EditText ListView SearchView
+            ImageView ImageView$ScaleType]
            android.app.ProgressDialog
            [android.view View ViewGroup$LayoutParams]))

@@ -48,6 +49,10 @@
     :search-view {:classname android.widget.SearchView
                   :inherits :view-group
                   :traits [:on-query-text]}
+    :image-view {:classname android.widget.ImageView
+                 :inherits :view
+                 :value-namespaces
+                 {:scale-type android.widget.ImageView$ScaleType}}

     ;; Other
     :layout-params {:classname ViewGroup$LayoutParams


Use new general-purpose monitoring security group

--- src/exploud/messages/data.clj
+++ src/exploud/messages/data.clj
@@ -19,7 +19,7 @@
             [ring.util.codec :refer [base64-decode]]))

 (def ^:private required-security-group-names
-  ["exploud-healthcheck" "nrpe"])
+  ["exploud-healthcheck" "mgmt-mon-scan"])

 (defn start-deployment-preparation
   [{:keys [parameters]}]


Implement data reading ops

Implement data reading ops

--- src/grimoire/api/web/read.clj
+++ src/grimoire/api/web/read.clj
@@ -85,33 +85,25 @@
       ;; versions is a Fail, pass it down
       versions)))

-(defmethod api/thing->prior-versions :web [config thing]
-  ;; FIXME: Needs to return a Succeed[Seq[Thing]]
-  ;; FIXME
-  )
-
 (defmethod api/read-notes :web [config thing]
-  ;; FIXME: Needs to return a Succeed[Map]
-  (-> thing
-     (make-request "notes")
-     edn/read-string))
+  {:pre [(isa? :def def-thing)]}
+  (do-data-op thing "notes"))

 (defmethod api/read-examples :web [config def-thing]
-  ;; FIXME: Needs to return a Succeed[Seq[Example]]
-  ;; FIXME: should check that def-thing is a def
-  (-> def-thing
-     (make-request "examples")
-     edn/read-string))
+  {:pre [(isa? :def def-thing)]}
+  (do-data-op def-thing "examples"))

 (defmethod api/read-meta :web [config thing]
-  ;; FIXME: Needs to return a Succeed[Meta]
-  (-> thing
-     (make-request "meta")
-     edn/read-string))
+  (do-data-op thing "meta"))

 (defmethod api/read-related :web [config def-thing]
-  ;; FIXME: Needs to return a Succeed[Seq[Thing]]
-  ;; FIXME: should check that def-thing is a def
+  {:pre [(isa? :def def-thing)]}
   ;; FIXME: not implemented on the Grimoire side see clojure-grimoire/grimoire#152
-  (-> def-thing
-     (make-request "related")))
+  ;; Grimoire will yeild Succeed[Seq[qualifiedSymbol]]
+  (let [version (thing->version def-thing)
+        ?res    (do-data-op def-thing "related")]
+    (if (succeed? ?res)
+      (->> ?res result
+         (map (comp #(path->thing (str (thing->path version) "/" %1)) :name))
+         succeed)
+      ?res)))


Removed unused var

Removed unused var

--- src/leiningen/amp/package.clj
+++ src/leiningen/amp/package.clj
@@ -173,7 +173,6 @@

         ; Source paths
         src-file-mapping       (io/file src-amp "file-mapping.properties")
-        src-web                (io/file src-amp "web")

         ; Target paths (where the AMP gets constructed)
         target                 (io/file (:target-path project))


Exit with return code in default test task

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

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

 (deftask auto-test []
   (comp (testing)


Cleanup again

Cleanup again

--- src/holston/tasting_service.clj
+++ src/holston/tasting_service.clj
@@ -11,7 +11,10 @@
           (:id (search-func name))))))

 (defn- add-beer [beer-name brewery-name]
-  (fn [] (repo/add-beer beer-name (import-named-entity brewery-name repo/get-brewery (fn [] (repo/add-brewery brewery-name))))))
+  (fn []
+    (repo/add-beer
+     beer-name
+     (import-named-entity brewery-name repo/get-brewery (fn [] (repo/add-brewery brewery-name))))))

 (defn- add-or-select-beer [beer-name brewery-name]
   (import-named-entity beer-name repo/get-beer (add-beer beer-name brewery-name)))


reformat for conventional style, and refer to fns without the reader macro

--- src/kilo/messaging/listener.clj
+++ src/kilo/messaging/listener.clj
@@ -1,21 +1,18 @@
 (ns kilo.messaging.listener
-  (:require
-    [clojure.data.json :as json]
-    [immutant.messaging :as msg]
-    [kilo.data.resource-accessor :as k-resource]))
+  (:require [clojure.data.json :as json]
+            [immutant.messaging :as msg]
+            [kilo.data.resource-accessor :as k-resource]))

 (def entity-functions
   "Maps incoming 'operation' value with a function that implements
    analagous operation via Korma db functions."
-  {
-   :put #'k-resource/set-data
-   :get #'k-resource/get-data})
+  {:put k-resource/set-data
+   :get k-resource/get-data})

 (defn process-message
   "Receives message from queue and assembles call to the function that will
    either retrieve data from the db or update data in the db (depending on
-   'operation' value in message.
-"
+   'operation' value in message."
   [message]
   (let [parsed-message (json/read-str message :key-fn keyword)
         header (:header parsed-message)


let 'call-files' return a path -> result/throwable seq.

--- src/leiningen/ancient/utils.clj
+++ src/leiningen/ancient/utils.clj
@@ -60,16 +60,16 @@

 (defn report-file-failures
   [{:keys [opts]} sq]
-  (if (:report? opts)
-    (let [sq (sort-by first sq)]
+  (when (:report? opts)
+    (let [sq' (sort-by first sq)]
       (verbosef "Report:%n-------")
-      (doseq [[file t] sq]
-      (verbosef "%s %s"
-                (if (throwable? t)
-                  (color/red "[fail]")
-                  (color/green "[ok]  "))
-                file)))
-    (dorun sq)))
+      (doseq [[file t] sq']
+        (verbosef "%s %s"
+                  (if (throwable? t)
+                    (color/red "[fail]")
+                    (color/green "[ok]  "))
+                  file))))
+  (doall sq))

 (defn call-files
   "Call the given function on all `DependencyFile` values, logging
@@ -122,8 +122,8 @@
                                  (keep collect/project-file-at args)))]
     (call-files f o files-if-multiple)
     (if (:root project)
-      (->> (collect/current-project-file project)
-           (call-file f o))
+      (let [file (collect/current-project-file project)]
+        [[(path-string file) (call-file f o file)]])
       (warnf "not inside of a project."))))

 (defn call-on-profiles-files


Добавлен компонен группы переключателей кнопок

--- radiolamp-6P3S/src/ixinfestor/omut.cljs
+++ radiolamp-6P3S/src/ixinfestor/omut.cljs
@@ -1343,6 +1343,7 @@
                   :active? (@app :value)
                   :disabled? disabled?
                   :on-click (fn [_]
+                              (when before-onClick-fn (before-onClick-fn))
                               (om/transact! app :value not)
                               (when onClick-fn (onClick-fn)))
                   :text (if (@app :value) text-on text-off)}))))
@@ -1365,6 +1366,53 @@
                (dom/div #js {:className input-class+ :style #js {}}
                         (om/build toggle-button app {:opts spec-toggle-button})
                         (om/build helper-p app {}) )))))
+
+
+
+
+
+(defn toggle-buttons-selector-group-app-init [buttons]
+  {:buttons (vec (map
+                  (fn [{:keys [value key] :as b} i]
+                    (assoc b
+                           :value (if (nil? value) false value)
+                           :key key))
+                  buttons))})
+
+(defn toggle-buttons-selector-get-selected [app]
+  (->> app :buttons (filter :value) (map :key)))
+
+(defn toggle-buttons-selector-get-selected-one [app]
+  (first (toggle-buttons-selector-get-selected app)))
+
+
+(defn toggle-buttons-selector-group [app own {:keys [selection-type
+                                                     onClick-fn]}]
+  (reify
+    om/IRender
+    (render [_]
+      (->> app
+           :buttons
+           (map (fn [app-row]
+                  (let [{:keys [bs-type value disabled? text]} @app-row]
+                    (ui-button
+                     {:type (or bs-type :default)
+                      :active? value
+                      :disabled? disabled?
+                      :on-click
+                      (fn [_]
+                        (when (= selection-type :one)
+                          (om/transact!
+                           app :buttons
+                           (fn [app] (vec (map #(assoc % :value false) app)))))
+                        (om/transact! app-row :value not)
+                        (when onClick-fn (onClick-fn)))
+                      :text text}))))
+           (apply
+            dom/div #js {:className "btn-group" :role "group"})))))
+
+
+

 ;; END toggle batton
 ;;..................................................................................................
@@ -2304,7 +2352,7 @@
                                            :href (or href "#") :target "_blank"}
                                       (dom/button #js {:className "btn btn-success"} "скачать")))
                     (when heading ((or heading-tag dom/h4) #js {:className "media-heading"} heading
-                                          (when heading-2 (dom/small nil " - " heading-2 ))))
+                                   (when heading-2 (dom/small nil " - " heading-2 ))))
                     body)))


Fixes #3 (simple-brepl) => "No such namespace: shrimp.init"

Employs workaround for a Weasel issue detailed at
https://github.com/mfikes/weasel-src-paths

--- ClojureScript/project.clj
+++ ClojureScript/project.clj
@@ -7,7 +7,8 @@
                            [weasel "0.5.0"]]
             :plugins [[lein-cljsbuild "1.0.3"]
                       [jarohen/simple-brepl "0.2.1"]]
-            :source-paths ["src"]
+            :source-paths ["src"
+                           "dev-src"]
             :brepl {:ip "127.0.0.1"}
             :cljsbuild {:builds {:dev
                                   {:source-paths ["src"


explicitly require clojure.set so lein test doesn't blow up

--- plugins/matross/connections/vagrant.clj
+++ plugins/matross/connections/vagrant.clj
@@ -1,7 +1,8 @@
 (ns matross.connections.vagrant
   (:require [me.raynes.conch :refer [with-programs]]
             [matross.connections.core :refer [IConnect IRun get-connection] :as core]
-            [matross.connections.ssh :refer [ssh-connection]]))
+            [matross.connections.ssh :refer [ssh-connection]]
+            [clojure.set]))

 (deftype Vagrant [ssh-future]


[registry] Unify underscores and dashes in `module-lookup`.

--- src/cortex/registry.cljc
+++ src/cortex/registry.cljc
@@ -14,11 +14,11 @@

 (defn lookup-module [module-name]
   "Look up a module from the module registry."
-  #?(:clj
-      (let [last-dot (.lastIndexOf module-name ".")
-            ns-name (.substring module-name 0 last-dot)
-            item-name (.substring module-name (+ 1 last-dot))
-            cons-fn (resolve (symbol ns-name (str "map->" item-name)))]
-        cons-fn)
-     :cljs
-      (get @module-registry* module-name)))
+  #?(:clj
+     (let [module-name (.replace module-name \_ \-)
+           last-dot (.lastIndexOf module-name ".")
+           ns-name (.substring module-name 0 last-dot)
+           item-name (.substring module-name (+ 1 last-dot))
+           cons-fn (resolve (symbol ns-name (str "map->" item-name)))]
+       cons-fn)
+     :cljs (get @module-registry* module-name)))


fix examples

fix examples

--- examples/hello/page.cljs
+++ examples/hello/page.cljs
@@ -4,7 +4,7 @@
             [garden.core :refer [css]]
             [garden.units :as u :refer [px pt em]]
             [garden.color :as color :refer [hsl rgb]]
-            [gardener.dom :as gardom]
+            [mesh.core.dom :as gardom]
             [mesh.typography :as typo :refer [typeset]]
             [mesh.grid :as grid]))


taking a stab at this

taking a stab at this

--- resources/languages/de/rules/numbers.clj
+++ resources/languages/de/rules/numbers.clj
@@ -57,6 +57,17 @@
               "siebzig" 70 "achtzig" 80 "neunzig" 90}
              (-> %1 :groups first .toLowerCase))
    :grain 1}
+
+ "integer ([2-9][1-9])"
+ #"(?i)(ein|zwei|drei|vier|fünf|sechs|sieben|acht|neun)und(zwanzig|dreissig|vierzig|fünfzig|sechzig|siebzig|achtzig|neunzig)"
+ {:dim :number
+  :integer true
+  :value (+ (get {"ein" 1 "zwei" 2 "drei" 3 "vier" 4 "fünf" 5
+                  "sechs" 6 "sieben" 7 "acht" 8 "neun" 9}
+                 (-> %1 :groups first .toLowerCase))
+            (get {"zwanzig" 20 "dreissig" 30 "vierzig" 40 "fünfzig" 50
+                  "sechzig" 60 "siebzig" 70 "achtzig" 80 "neunzig" 90}
+                 (-> %2 :groups first .toLowerCase)))}

  ; "integer 21..99"
  ; [(integer 10 90 #(#{20 30 40 50 60 70 80 90} (:value %))) (integer 1 9)]


Dead code removal

Dead code removal

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -1,7 +1,4 @@
-(ns devtools.format
-  (:require
-    [devtools.debug :as debug]
-    ))
+(ns devtools.format)

 (def max-coll-elements 5)
 (def more-marker "…")
@@ -16,8 +13,6 @@
 (def li "li")
 (def general-cljs-land-style "background-color:#efe")

-(declare inlined-value-template)
-
 ; IRC #clojurescript @ freenode.net on 2015-01-27:
 ; [13:40:09] darwin_: Hi, what is the best way to test if I'm handled ClojureScript data value or plain javascript object?
 ; [14:04:34] dnolen: there is a very low level thing you can check
@@ -145,7 +140,7 @@
 (defn managed-pr-str [value print-level]
   (let [tmpl (template span "")
         writer (TemplateWriter. tmpl)]
-    (binding [*print-level* print-level] ; when printing do at most print-level deep recursion
+    (binding [*print-level* print-level]                    ; when printing do at most print-level deep recursion
       (pr-seq-writer [value] writer {:alt-impl     alt-printer-impl
                                      :print-length max-coll-elements
                                      :more-marker  more-marker}))
@@ -205,4 +200,4 @@
 (defn body-api-call [value]
   (cond
     (satisfies? IDevtoolsFormat value) (-body value)
-    (surrogate? value) (build-surrogate-body value)))
+    (surrogate? value) (build-surrogate-body value)))


Memoize cache few fns

Memoize cache few fns

--- src/name_bazaar/ui/utils.cljs
+++ src/name_bazaar/ui/utils.cljs
@@ -14,8 +14,10 @@
     [name-bazaar.ui.db :refer [default-db]]
     [taoensso.timbre :as logging :refer-macros [info warn error]]))

-(defn namehash [name]
-  (js/EthEnsNamehash.hash name))
+(def namehash
+  (memoize
+   (fn namehash* [name]
+     (js/EthEnsNamehash.hash name))))

 (defn normalize [name]
   (js/EthEnsNamehash.normalize name))
@@ -173,6 +175,8 @@
     (truncate name-or-addr (or trunc 10))
     (strip-root-registrar-suffix name-or-addr)))

-(defn reverse-record-node [addr]
-  (namehash (str (apply str (drop 2 addr))
-                 ".addr.reverse")))
+(def reverse-record-node
+  (memoize
+   (fn reverse-record-node*
+     [addr] (namehash (str (apply str (drop 2 addr))
+                           ".addr.reverse")))))


crawler.clj: omit charset from content type, better redirects

--- src/org/altlaw/util/crawler.clj
+++ src/org/altlaw/util/crawler.clj
@@ -28,7 +28,12 @@
   (let [form (Form.)]
     (doseq [[key value] fields]
       (.add form (j/as-str key) (j/as-str value)))
-    (.getWebRepresentation form)))
+    (let [entity (.getWebRepresentation form)]
+      ;; Some servers (e.g. the IIS server at www.ca2.uscourts.gov)
+      ;; don't accept POST requests with a "charset=" attribute in the
+      ;; "Content-Type" header, so set charset to null.
+      (.setCharacterSet entity nil)
+      entity)))

 (defn- set-client-agent [request]
   (.. request getClientInfo
@@ -72,7 +77,7 @@
   "Returns the response entity as a Base64-encoded string, or nil if
   no response entity."
   [response]
-  (when-let [entity (.. response getEntity)]
+  (when-let [entity (.getEntity response)]
     (when (.isAvailable entity)
      (String. (Base64/encodeBase64Chunked
                (IOUtils/toByteArray (.getStream entity)))
@@ -106,9 +111,10 @@
         headers (into {} (:response_headers result))
         location (get headers "Location")
         original-request (select-keys result [:request_form_fields
-                                              :request_headers])
+                                              :request_headers :request_uri])
         new-request (assoc original-request :request_uri location)]
-    (log/warn "HTTP response " code " to " (pr-str original-request))
+    (log/info "HTTP response " code " to " (pr-str original-request))
+    (log/info "Redirecting to " location)
     (assoc (handle-download-request new-request) :redirect_from result)))

 (defn- execute-request


Debugging mapbox

Debugging mapbox

--- src/pasmo_gigi/geo/ui/core.cljs
+++ src/pasmo_gigi/geo/ui/core.cljs
@@ -17,11 +17,11 @@
   (.log js/console "mapbox api: " mapbox-api)
   (let [mapbox (gob/get mapbox-api "mapbox")]
     (.log js/console "mapbox prop from api: " mapbox)
-    #_(set! (.-accessToken mapbox) "pk.eyJ1IjoidXJpczc3IiwiYSI6InRuYTZRa3MifQ._Bo-JRcA7QVGocCJvdSoJg")
     (gob/set mapbox "accessToken" "pk.eyJ1IjoidXJpczc3IiwiYSI6InRuYTZRa3MifQ._Bo-JRcA7QVGocCJvdSoJg")
     (swap! db/settings assoc :mapbox-api mapbox-api))

-  (.log js/console "set: " (.-accessToken (.-mapbox (:mapbox-api @db/settings))))
+  #_(.log js/console "set: " (.-accessToken (.-mapbox (:mapbox-api @db/settings))))
+  (.log js/console "setting: " (clj->js (:mapbox-api @db/settings)))
   (:mapbox-api @db/settings))

 (defn mount-root


add retry functionality to #'download-file

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -188,9 +188,30 @@
   "Downloads the file pointed to by URI to local path target-path. If no timeout
   is specified will use blocking io to transfer data. If timeout is specified,
   transfer will block for at most timeout ms before throwing a
-  java.net.SocketTimeoutException if data transfer has stalled."
-  ([url target-path] (download-file-without-timeout url target-path))
-  ([url target-path timeout] (download-file-with-timeout url target-path timeout)))
+  java.net.SocketTimeoutException if data transfer has stalled.
+
+  It's also possible to specify num-retries to determine how many attempts to
+  make to download the file and also the time-between-retries in ms (defaults to
+  5000 ms)"
+  ([url path]                          (download-file-without-timeout url path))
+  ([url path timeout]                  (download-file-with-timeout url path timeout))
+  ([url path timeout n-retries]        (download-file url path timeout n-retries 5000))
+  ([url path timeout n-retries wait-t] (download-file url path timeout n-retries wait-t 0))
+  ([url path timeout n-retries wait-t attempts-made]
+     (when (>= attempts-made n-retries)
+       (throw (Exception. (str "Aborting! Download failed after "
+                               n-retries
+                               " attempts. URL attempted to download: "
+                               url ))))
+
+     (let [path (resolve-tilde-path path)]
+       (try
+         (download-file-with-timeout url path timeout)
+         (catch java.io.IOException e
+           (rm-rf! path)
+           (Thread/sleep wait-t)
+           (download-file url path timeout n-retries wait-t (inc attempts-made)))))))
+

 (defn file-size
   "Returns the size of the file pointed to by path in bytes"


making metronome bpm adjustment return something nicer.

--- src/overtone/music/rhythm.clj
+++ src/overtone/music/rhythm.clj
@@ -43,7 +43,8 @@
              cur-beat (long (/ (- (now) @start) @tick-ms))
              new-start (- (now) (* tms cur-beat))]
          (reset! tick-ms tms)
-         (reset! start new-start))))))
+         (reset! start new-start))
+       [:bpm bpm]))))

 ;== Grooves
 ;


documentation update

documentation update

--- src/engine/data/rope.clj
+++ src/engine/data/rope.clj
@@ -437,7 +437,9 @@
 (defmethod print-method Bud [bud writer]
   (print-simple (format "#<Bud %s>" (->> (measure bud) vals (join "/"))) writer))

-(defn file-chunk [file pos len]
+(defn file-chunk
+  "Fresh Bud that reads from file"
+  [file pos len]
   (let [readfn (fn []
                  (with-open [file (RandomAccessFile. file "r")]
                    (let [data (byte-array len)]
@@ -451,8 +453,9 @@
                   (take-while #(< (second %) end)))]
     (concat (butlast coll) [[(-> coll last first) (dec end)]])))

-(defn file->rope [path]
+(defn file->rope
   "Fresh Rope from file"
+  [path]
   (let [file (File. path), size (.length file),
         step (-> size (/ (.. Runtime getRuntime availableProcessors)) Math/ceil int)]
     (letfn [(build [acc]


Some reformatting

Some reformatting

--- parser/parser.clj
+++ parser/parser.clj
@@ -30,12 +30,13 @@

 (def sexp-to-function-type (name parameters range)
      (match parameters
-            (Cons (List arg-types _) (Cons return-type Empty))  (result-flatmap (fn (arg-types)
-                                                                (result-map     (fn (return-type)
-                                                                                (FunctionType arg-types return-type range))
-                                                                                (sexp-to-type return-type)))
-                                                                                (sexp-to-types arg-types))
-            _                                          (Error (MalformedTypeError range))))
+            (Cons (List arg-types _) (Cons return-type Empty))
+                    (result-flatmap (fn (arg-types)
+                    (result-map     (fn (return-type)
+                                        (FunctionType arg-types return-type range))
+                                    (sexp-to-type return-type)))
+                                    (sexp-to-types arg-types))
+            _   (Error (MalformedTypeError range))))

 (def sexp-to-complex-or-function-type (name parameters range)
      (match (function-type? name)


adding empty lines is no longer needed here

since we treat linebreaks as spatials

--- cljs/src/worker/plastic/worker/editor/layout/spatial.cljs
+++ cljs/src/worker/plastic/worker/editor/layout/spatial.cljs
@@ -4,15 +4,9 @@
             [plastic.util.zip :as zip-utils]
             [plastic.worker.editor.toolkit.id :as id]))

-(defn token? [selectable]
+(defn spatial? [selectable]
   (let [tag (:tag selectable)]
     (#{:token :linebreak} tag)))
-
-(defn add-empty-lines [selectables]
-  (let [line-numbers (keys selectables)
-        lines-range (range (apply min line-numbers) (apply max line-numbers))
-        empty-lines (into (sorted-map) (map (fn [l] [l []]) lines-range))]
-    (merge empty-lines selectables)))

 (defn build-spatial-web [root-loc selectables]
   (let [all-locs (zip-utils/zip-seq root-loc)
@@ -20,8 +14,7 @@
                             (let [id (zip-utils/loc-id loc)
                                   spot-id (id/make-spot id)]
                               [(get selectables id) (get selectables spot-id)]))
-        selectables (filter token? (remove nil? (mapcat fetch-selectables all-locs)))]
-    (->> selectables
+        spatial-selectables (filter spatial? (mapcat fetch-selectables all-locs))]
+    (->> spatial-selectables
       (group-by :line)                                                                                ; guaranteed to be in left-to-right order because all-locs are left-to-right
-      (into (sorted-map))
-      (add-empty-lines))))
+      (into (sorted-map)))))                                                                                ; here we care about ordering by lines


Temp solution: field type could be an interface

--- src/graphql_clj/type.clj
+++ src/graphql_clj/type.clj
@@ -159,13 +159,22 @@
     (gerror/throw-error "get-enum-in-schema: enum-name is NULL!"))
   (get-in schema [:enums enum-name]))

+(defn get-interface-in-schema [schema interface-name]
+  "Get interface definition for given 'interface-name' from provided 'schema'."
+  (if (nil? interface-name)
+    (gerror/throw-error "get-interface-in-schema: interface-name is NULL!"))
+  (get-in schema [:interfaces interface-name]))
+
 (defn get-type-in-schema [schema type-name]
     "Get type definition for given 'type-name' from provided 'schema'."
   (if (nil? type-name)
     (gerror/throw-error "get-type-in-schema: type-name is NULL!"))
   (or (get-in schema [:types type-name])
       ;; type could be enum
-      (get-enum-in-schema schema type-name)))
+      (get-enum-in-schema schema type-name)
+      ;; TODO: type could be interface, Should also check type implments interface
+      (get-interface-in-schema schema type-name)
+      ))

 (defn get-root-query-type
   "Get root query type name from schema definition."


added detailed instructions

added detailed instructions

--- src/cljs/work_sessions/components/headers.cljs
+++ src/cljs/work_sessions/components/headers.cljs
@@ -10,16 +10,89 @@
 (defn instructions []
   [:h4.instructions
    [:p
-    "Join a simultaneous work session from your computer using "
+    "EN"]
+   [:p
+    "Join a simultaneous work session from your computer by opening "
+    [:a {:href "https://hangouts.google.com/hangouts/_/qrx7a5fwlrhedpmm73amlkrtiye"
+         :target "blank"}
+     "THIS LINK"]
+    " with "
     [:a {:href "https://www.google.com/chrome/"
          :target "blank"}
      "Google Chrome"]
-    " with "
+    ". Then add "
     [:a {:href "https://chrome.google.com/webstore/detail/google-hangouts/nckgahadagoaajjgafhacjanaoiihapd"
          :target "blank"}
      "Hangouts Chrome extension"]
-    " installed. To join a simultaneous work session from your
-    smartphone or tablet install the Hangouts app."]])
+    " and press Join the video chat"]
+
+   [:p
+    "To join a simultaneous work session from your smartphone or tablet install the Hangouts app. For that open "
+    [:a {:href "https://hangouts.google.com/hangouts/_/qrx7a5fwlrhedpmm73amlkrtiye"
+         :target "blank"}
+     "THIS LINK"]
+    " with "
+    [:a {:href "https://www.google.com/chrome/"
+         :target "blank"}
+     "Google Chrome"]
+    " and join the call after installing Hangouts."]
+
+   [:p
+    "You can be present with an image of you, you can also share your screen with your current work. The sound stays on."]
+
+   [:p
+    "In this very session we are focusing on the things that we wanted to do for a long time, but haven’t got time for that, the things that are oppressing us: answering emails that we were escaping to answer, writing to a friend that is waiting, composing a text that is hanging on you, something that screws you up."]
+
+   [:p
+    "This is a digital union of non-material workers, the virtual space of multi-user processing, so try not to distract each other, you can watch someone doing her cognitive work."]
+
+   [:p
+    "The session length is 1 hour, 13.30 – 14.30 Helsinki and Moscow time."]
+
+   [:p
+    "The next session will be in a week – on 2 June, time stays the same."]
+   ;;
+   ;; RUSSIAN
+   ;;
+   [:p
+    "РУС"]
+
+   [:p
+    "Если ты присоединяешься к сессии при помощи компьютера. Открываешь в "
+    [:a {:href "https://www.google.com/chrome/"
+         :target "blank"}
+     "Google Chrome"]
+    " "
+    [:a {:href "https://hangouts.google.com/hangouts/_/qrx7a5fwlrhedpmm73amlkrtiye"
+         :target "blank"}
+     "ССЫЛКУ"]
+    ". Устанавливаешь расширение "
+    [:a {:href "https://chrome.google.com/webstore/detail/google-hangouts/nckgahadagoaajjgafhacjanaoiihapd"
+         :target "blank"}
+     "Hangouts для Chrome"]
+    ". Нажимаешь Присоединиться к видео звонку."]
+
+   [:p
+    "Если присоединяешься при помощи телефона или планшета, устанавливаешь приложение Hangouts.  Открываешь в "
+    [:a {:href "https://www.google.com/chrome/"
+         :target "blank"}
+     "Google Chrome"]
+    " "
+    [:a {:href "https://hangouts.google.com/hangouts/_/qrx7a5fwlrhedpmm73amlkrtiye"
+         :target "blank"}
+     "ССЫЛКУ"]
+    " и присоединяешься к видео звонку после установки приложения."]
+   [:p
+    "Можешь присутствовать на сессии своим изображением, можешь расшаривать экран со своей работой. Звук оставляешь включенным."]
+   [:p
+    "В первой серии мы фокусируемся на тех вещах, которые уже давно хотели сделать, но нам не хватало времени, на вещах, которые нас гнетут – ответы на залежавшиеся email-ы; письмо подруге, которая ждет; текст, который давно весит на тебе; работа, которая не дает тебе покоя."]
+   [:p
+    "Представьте, что это союз нематериальных работников, виртуальное пространство совместной работы, поэтому старайтесь не отвлекать друг друга, можете наблюдать, как кто-то другой занимается своим когнитивным трудом."]
+   [:p
+    "Продолжительность сессии – 1 час, с 13.30 до 14.30 по Хельсинки и Москве."]
+   [:p
+    "Следующая сессия будет через неделю – 2 июня в это же время."]
+   ])

 (defn headers-view []
   (let [headers (subscribe [:headers/all])
@@ -70,7 +143,7 @@
                         (unescapeEntities "Session #1")]
                        (gstring/unescapeEntities ": 26 May, 13:30 — 14:30 Helsinki time")]
                       #_[:hr]
-                      [:h4
+                      #_[:h4
                        (gstring/unescapeEntities "Session #2: 2 June, 13:30 — 14:30 Helsinki time")]
                       #_[:hr]
                       (instructions)


CMR-6239 PR comments.

CMR-6239 PR comments.

--- indexer-app/src/cmr/indexer/data/elasticsearch.clj
+++ indexer-app/src/cmr/indexer/data/elasticsearch.clj
@@ -211,11 +211,8 @@
   "Takes a non-tombstoned concept map (a normal revision) and returns an elastic document suitable
    for bulk indexing."
   [context concept]
-  (let [parsed-concept (cp/parse-concept context concept)
-        delete-time (get-in parsed-concept
-                            [:data-provider-timestamps :delete-time])
-        elastic-doc (parsed-concept->elastic-doc context concept parsed-concept)]
-    elastic-doc))
+  (let [parsed-concept (cp/parse-concept context concept)]
+    (parsed-concept->elastic-doc context concept parsed-concept)))

 (defn- concept->bulk-elastic-docs
   "Converts a concept map into an elastic document suitable for bulk indexing."


Remove unused internal ‘goog-extend’ function

--- modules/reitit-core/src/reitit/impl.cljc
+++ modules/reitit-core/src/reitit/impl.cljc
@@ -252,15 +252,3 @@
                 (str/join "&" (map query-parameter (repeat k) v))
                 (query-parameter k v))))
        (str/join "&")))
-
-(defmacro goog-extend [type base-type ctor & methods]
-  `(do
-     (def ~type (fn ~@ctor))
-
-     (goog/inherits ~type ~base-type)
-
-     ~@(map
-         (fn [method]
-           `(set! (.. ~type -prototype ~(symbol (str "-" (first method))))
-                  (fn ~@(rest method))))
-         methods)))


Add trailing slash handler

Add trailing slash handler

--- modules/reitit-ring/src/reitit/ring.cljc
+++ modules/reitit-ring/src/reitit/ring.cljc
@@ -109,6 +109,35 @@
                      (handler request respond' raise))
                    (respond nil)))]
          (f handlers))))))
+
+(defn redirect-trailing-slash-handler
+  "A ring handler that redirects a missing path if there is an
+  existing path that only differs in the ending slash.
+
+  | key     | description |
+  |---------|-------------|
+  | :method | :add - redirects slash-less to slashed |
+  |         | :strip - redirects slashed to slash-less |
+  |         | :both - works both ways (default) |
+  "
+  [{:keys [method] :or {method :both}}]
+  (let [redirect-handler (fn redirect-handler [request]
+                           (let [uri (:uri request)
+                                 maybe-redirect (fn maybe-redirect [path]
+                                                  (if (r/match-by-path (::r/router request) path)
+                                                    {:status 308 ; permanent redirect
+                                                     :headers {"Location" path}
+                                                     :body ""}))]
+                             (if (str/ends-with? uri "/")
+                               (if (not= method :add)
+                                 (maybe-redirect (subs uri 0 (-> uri count dec))))
+                               (if (not= method :strip)
+                                 (maybe-redirect (str uri "/"))))))]
+    (fn
+      ([request]
+       (redirect-handler request))
+      ([request respond _]
+       (respond (redirect-handler request))))))

 (defn create-default-handler
   "A default ring handler that can handle the following cases,