Function to create job and use configuration template

--- src/emender_jenkins/jenkins_api.clj
+++ src/emender_jenkins/jenkins_api.clj
@@ -22,9 +22,11 @@

 (defn update-jenkins-url
     [job-config-url jenkins-auth]
-    (cond (.startsWith job-config-url "https://") (str "https://" jenkins-auth "@" (subs job-config-url 8))
-          (.startsWith job-config-url "http://")  (str "http://"  jenkins-auth "@" (subs job-config-url 7))
-          :else job-config-url))
+    (if (empty? jenkins-auth)
+        job-config-url
+        (cond (.startsWith job-config-url "https://") (str "https://" jenkins-auth "@" (subs job-config-url 8))
+              (.startsWith job-config-url "http://")  (str "http://"  jenkins-auth "@" (subs job-config-url 7))
+              :else job-config-url)))

 (defn post-command
     [jenkins-url jenkins-auth job-name command]
@@ -77,6 +79,12 @@
              :message (.getMessage e)
             })))

+(defn update-template
+    [template git-repo branch]
+    (-> template
+        (clojure.string/replace "<placeholder id=\"git-repo\" />" git-repo)
+        (clojure.string/replace "<placeholder id=\"git-branch\" />" (str "*/" branch))))
+
 (defn start-job
     [jenkins-url jenkins-auth job-name]
     (job-related-command jenkins-url jenkins-auth job-name "build"))
@@ -93,3 +101,34 @@
     [jenkins-url jenkins-auth job-name]
     (job-related-command jenkins-url jenkins-auth job-name "doDelete"))

+(defn create-job
+    [jenkins-url jenkins-auth job-name git-repo branch]
+    (println "***create job***")
+    (println "job-name" job-name)
+    (println "git-repo" git-repo)
+    (println "branch"   branch)
+    (let [template (slurp "data/template.xml")
+          config   (update-template template git-repo branch)
+          url      (str (update-jenkins-url jenkins-url jenkins-auth) "createItem?name=" (.replaceAll job-name " " "%20"))]
+          (println "URL to use: " url)
+          ;(spit "data/config2.xml" config)
+          (try
+              (let [response (http-client/post url {
+                      :body config
+                      :content-type "application/xml"
+                      :keystore "keystore"
+                      :keystore-pass "changeit"
+                      :trust-store "keystore"
+                      :trust-store-pass "changeit"})]
+                {:status   "ok"
+                 :job-name job-name
+                 :command  "create"
+                 :jenkins-response response})
+            (catch Exception e
+                (.printStackTrace e)
+                {:status "error"
+                 :job-name job-name
+                 :command  "create"
+                 :message (.getMessage e)
+                }))))
+


Cooler names.

Cooler names.

--- src/kolmogorov_music/kolmogorov.clj
+++ src/kolmogorov_music/kolmogorov.clj
@@ -49,7 +49,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The Library of Babel ;;;
+;;; The Library of Babel ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn kleene* [elements]
@@ -84,7 +84,7 @@

 ;;;;;;;;;;;;;;;;;;;;;
-;;; Drawing Hands ;;;
+;;; Drawing Hands ;;;
 ;;;;;;;;;;;;;;;;;;;;;

 (defn complexity
@@ -92,13 +92,18 @@
   [string]
   (->> string (map int) (reduce + 0)))

-(defn enterprise
-  "Calculate the shortest string that is more complicated than itself."
+(defmacro enterprise
+  "Calculate the shortest string that is more complicated than the specified sym."
+  [sym]
+  `(let [source# (-> ~sym quote repl/source-fn)]
+     (->> (babel)
+       (drop-while #(<= (complexity %) (result-length source#)))
+       first)))
+
+(defn yo-dawg
+  "I heard you like complexity, so I put some enterprise in your enterprise."
   []
-  (let [its-own-source (repl/source-fn 'enterprise)]
-    (->> (babel)
-         (drop-while (fn [s] (<= (complexity s) (value-length its-own-source))))
-         first)))
+  (enterprise enterprise))

 ;;;;;;;;;;;;;;;;
@@ -220,8 +225,7 @@
           (then
             (phrase [1/2 6/2 1/2 1/2 6/2 1/2 1/2 6/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2]
                     [-17 nil -17 -17 nil -17 -17 nil -17 -10 -3 -11 -4 -12 -5 -13 -14])))
-        harmony (phrase [32] [14])
-        ]
+        harmony (phrase [32] [14])]
     (->>
       (with bass accompaniment)
       (wherever :pitch, :pitch (comp scale/A scale/major))


add cljs.build.api/add-implicit-options

add cljs.build.api/add-implicit-options

--- src/main/clojure/cljs/build/api.clj
+++ src/main/clojure/cljs/build/api.clj
@@ -96,6 +96,13 @@
 ;; =============================================================================
 ;; Main API

+(defn add-implicit-options
+  "Given a valid map of build options add any standard implicit options. For
+  example :optimizations :none implies :cache-analysis true and :source-map
+  true."
+  [opts]
+  (closure/add-implicit-options opts))
+
 (defn inputs
   "Given a list of directories and files, return a compilable object that may
   be passed to build or watch."


tweaks to type support

tweaks to type support

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -476,7 +476,8 @@
     (emitln "throw " throw ";")))

 (def base-types
-  #{"boolean" "Boolean"
+  #{"null" "*"
+    "boolean" "Boolean"
     "string" "String"
     "number" "Number"
     "array" "Array"
@@ -484,9 +485,14 @@
     "RegExp"
     "Date"})

+(def mapped-types
+  {"nil" "null"})
+
 (defn resolve-type [env ^String t]
   (cond
     (get base-types t) t
+
+    (get mapped-types t) (get mapped-types t)

     #?(:clj  (.startsWith t "!")
        :cljs (gstring/startsWith t "!")) t
@@ -508,13 +514,19 @@
         (str ret "=")
         ret))))

+(defn type-munge [s]
+  (cond
+    (= "null" s) s
+    (= "*" s) s
+    :else (munge s)))
+
 (defn resolve-types [env ts]
   (let [ts (-> ts string/trim (subs 1 (dec (count ts))))
         xs (string/split ts #"\|")]
     (str
       "{"
       (->> (map #(resolve-type env %) xs)
-        (map munge)
+        (map type-munge)
         (string/join "|"))
       "}")))


Fix the persistent clojure-jack-in problem by removing the dependency from the tree.

--- backend/project.clj
+++ backend/project.clj
@@ -36,7 +36,6 @@
                  [vmfest "0.2.3"]

                  ;; Misc
-                 [swank-clojure "1.4.0-SNAPSHOT"]
                  [commons-codec "1.4"]
                  [org.apache.commons/commons-compress "1.0"]
                  [org.xeustechnologies/jtar "1.0.4"]


whitespace

whitespace

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -184,6 +184,7 @@

    {:pred :name}     {:physical-object false
                       :event false}
+
    {:pred :note}     {:legible true}

    {:pred :pizza}    {:artifact true


Drop unnecessary lambda.

Drop unnecessary lambda.

--- src/cavm/views/datasets.clj
+++ src/cavm/views/datasets.clj
@@ -16,7 +16,7 @@
   (response/empty))

 (defn genes-decode [genes]
-  (map #(codec/url-decode %) (clojure.string/split genes #",")))
+  (map codec/url-decode (clojure.string/split genes #",")))

 (defpage [:get ["/datasets/:id" :id #".+"]] {:keys [id genes]}
   (response/json (d/dataset-by-genes id (genes-decode genes))))


Shorter var name.

Shorter var name.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -40,18 +40,18 @@

 (defn storage-del [actx storage opaque key]
   (ago storage-del actx
-       (let [storage2 (swap! storage
-                             #(-> %
-                                  (assoc :max-deleted-sq (max (get-in % [:keys key])
-                                                              (:max-deleted-sq %)))
-                                  (dissoc-in [:changes (get-in % [:keys key])])
-                                  (dissoc-in [:keys key])
-                                  (assoc-in [:changes (:next-sq %)]
-                                            {:key key :sq (:next-sq %)
-                                             :deleted true})
-                                  (update-in [:next-sq] inc)))]
+       (let [s2 (swap! storage
+                       #(-> %
+                            (assoc :max-deleted-sq (max (get-in % [:keys key])
+                                                        (:max-deleted-sq %)))
+                            (dissoc-in [:changes (get-in % [:keys key])])
+                            (dissoc-in [:keys key])
+                            (assoc-in [:changes (:next-sq %)]
+                                      {:key key :sq (:next-sq %)
+                                       :deleted true})
+                            (update-in [:next-sq] inc)))]
          {:opaque opaque :status :ok
-          :key key :sq (dec (:next-sq storage2))})))
+          :key key :sq (dec (:next-sq s2))})))

 (defn storage-scan [actx storage opaque from to]
   (let [out (achan actx)]


Do not wait if winner is found by gaining a missed field

--- src/cljs/db_quiz/logic.cljs
+++ src/cljs/db_quiz/logic.cljs
@@ -152,13 +152,16 @@
   (update app-state :on-turn (partial toggle [:player-1 :player-2])))

 (defn test-winner
+  "Test if winner exists."
   [owner current-field]
-  (let [state (swap! app-state (partial change-ownership owner current-field))
+  (let [previous-ownership (get-in @app-state [:board current-field :ownership])
+        state (swap! app-state (partial change-ownership owner current-field))
         winner (find-winner (:board state))
         mark-fn (partial match-answer true)]
     (when winner
       (go (swap! app-state (comp mark-fn #(assoc % :winner winner)))
-          (<! (timeout verdict-display-time))
+          ; Showing correct answer is not necessary when a missed field is gained.
+          (when-not (= previous-ownership :missed) (<! (timeout verdict-display-time)))
           (swap! app-state (comp clear-answer deselect-current-field unmatch-answer))
           (redirect "#end")))))


add drawer

add drawer

--- src/cljs/relembra/core.cljs
+++ src/cljs/relembra/core.cljs
@@ -27,10 +27,9 @@

 (defonce conn (let [conn (d/create-conn)]
                 (d/transact! conn [{:db/id 0
+                                    :drawer/open false
                                     :addq/question-text ""
-                                    :addq/question-caret 0
-                                    :addq/answer-text ""
-                                    :addq/answer-caret 0}])
+                                    :addq/answer-text ""}])
                 (p/posh! conn)
                 conn))

@@ -73,12 +72,32 @@
      [:div.col-xs-12.col-sm-6 {:style {:padding-top "0.5em" :font-family "Yrsa, serif" :font-size "120%"}}
       [mathjax-box text]]]))

+(defn drawer []
+  (let [open @(p/q '[:find ?x . :where [0 :drawer/open ?x]] conn)]
+    [rui/drawer
+     {:docked false
+      :width 200
+      :open open
+      :on-request-change (fn [x] (println "on-request-change" x))}
+     [rui/menu-item {:on-touch-tap
+                     (fn [x]
+                        (println "on-touch-tap-1" x)
+                        (p/transact! conn [{:db/id 0 :drawer/open false}]))}
+      "Item 1"]
+     [rui/menu-item {:on-touch-tap
+                     (fn[x]
+                        (println "on-touch-tap-2" x)
+                        (p/transact! conn [{:db/id 0 :drawer/open false}]))}
+      "Item 2"]]))
+
 (defn app []
   [:div
    [rui/mui-theme-provider
-    {:mui-theme (ui/get-mui-theme {:palette {:text-color (ui/color :cyan900)}})}
+    {:mui-theme (ui/get-mui-theme {:palette {:text-color (ui/color :teal600)}})}
     [:div
-     [rui/app-bar {:title "Acrescenta pergunta"}]
+     [rui/app-bar {:title "Acrescenta pergunta"
+                   :on-left-icon-button-touch-tap #(p/transact! conn [{:db/id 0 :drawer/open true}])}]
+     [drawer]
      [:div.container
       [md-editor "Pergunta" :addq/question-text :addq/question-caret]
       [md-editor "Resposta" :addq/answer-text :addq/answer-caret]


don't blow up if ctype json and empty body

--- src/cljsbin/middleware.cljs
+++ src/cljsbin/middleware.cljs
@@ -1,5 +1,6 @@
 (ns cljsbin.middleware
   (:require
+   [clojure.string]
    [macchiato.middleware.defaults :as defaults]
    [macchiato.util.request :as util]
    [cljs.nodejs :as node]))
@@ -33,6 +34,12 @@
     (.startsWith type "application/json")))

 ;; TODO error should be 400 if payload is badly formatted
+(defn parse-json
+  [body raise]
+  (if-not (clojure.string/blank? body)
+    (try (js->clj (js/JSON.parse body))
+         (catch js/Error e (raise e)))))
+
 (defn wrap-json-body
   "If the request has json content-type, attempt to parse the body and
   set it in the :json property of the request."
@@ -42,8 +49,7 @@
       (concat-body
        (:body request)
        (fn [body]
-         (if-let [json-body (try (js->clj (js/JSON.parse body))
-                                 (catch js/Error e (raise e)))]
+         (let [json-body (parse-json body raise)]
            (-> request
                (assoc :json json-body)
                (assoc :body body) ;; not sure why this is needed, should be set by the other mw


added recovery codebase

added recovery codebase

--- src/clueweb_disqus/core.clj
+++ src/clueweb_disqus/core.clj
@@ -27,6 +27,25 @@
 (def session-start-time (atom nil))
 (def requests-in-session (atom 0))

+(defn get-api-key-for-start-epoch
+  [credentials since-epoch]
+  (or (-> credentials (get since-epoch) :api-key)
+      (let [orig-epochs (keys credentials)
+            correct-key (str
+                         (first
+                          (last
+                           (sort-by
+                            first
+                            (filter
+                             (fn [[e d]]
+                               (pos? d))
+                             (map
+                              vector
+                              (map #(Long/parseLong %) orig-epochs)
+                              (map #(- since-epoch (Long/parseLong %))
+                                   orig-epochs)))))))]
+        (-> credentials (get correct-key) :api-key))))
+
 (defn create-url
   ([since-epoch]
      (create-url since-epoch nil))
@@ -34,7 +53,7 @@
      (let [credentials (load-credentials)]
        (str thread-request-url
             "?api_key="
-            (-> credentials (get since-epoch) :api-key)
+            (get-api-key-for-start-epoch credentials (Long/parseLong since-epoch))
             "&since="
             since-epoch
             "&order=asc"
@@ -122,3 +141,37 @@
         first-page  (rate-limited-download request-url)]
     (write-content start-epoch first-page)
     (discover-iteration start-epoch first-page)))
+
+(defn get-last-written-file
+  "There should be only 1 - newer files
+   have different start-epoch"
+  [start-epoch]
+  (first
+   (filter
+    (fn [x]
+      (and (re-find (re-pattern start-epoch)
+                    (.getAbsolutePath x))
+           (re-find #".clj$" (.getAbsolutePath x))))
+    (file-seq
+     (java.io.File. ".")))))
+
+(defn threads-since-recover
+  "Reads the existing records and restarts the crawl from the next timestamp
+   onwards"
+  [start-epoch]
+  (let [last-file (get-last-written-file start-epoch)
+        pb-rdr (-> last-file io/reader java.io.PushbackReader.)
+        records-stream (take-while
+                        identity
+                        (repeatedly (fn [] (try (read pb-rdr)
+                                               (catch Exception e nil)))))
+
+        last-record (last records-stream)
+
+        formatter (f/formatters :date-hour-minute-second)]
+    (threads-since
+     (str
+      (quot
+       (c/to-long
+        (f/parse formatter (get last-record "createdAt")))
+       1000)))))


Added subcontext functions

Added subcontext functions

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

--- src/conexp/fca/contexts.clj
+++ src/conexp/fca/contexts.clj
@@ -526,6 +526,25 @@
 			  :when (<=> (I_1 [g_1,m_1])
 				     (I_2 [g_2,m_2]))])]
     (make-context new-objs new-atts new-inz)))
+
+;;;
+
+(defn subcontext?
+  "Tests whether ctx-1 is a subcontext ctx-2 or not."
+  [ctx-1 ctx-2]
+  (and (subset? (objects ctx-1) (objects ctx-2))
+       (subset? (attributes ctx-1) (attributes ctx-2))))
+
+(defn compatible-subcontext?
+  "Tests whether ctx-1 is a compatible subcontext of ctx-2."
+  [ctx-1 ctx-2]
+  (and (subcontext? ctx-1 ctx-2)
+       (forall [[h m] (up-arrows ctx-2)]
+	 (=> (contains? (objects ctx-1) h)
+	     (contains? (attributes ctx-1) m)))
+       (forall [[g n] (down-arrows ctx-2)]
+         (=> (contains? (attributes ctx-1) n)
+	     (contains? (objects ctx-1) g)))))

 (defn compatible-subcontexts
   "Returns all compatible subcontexts of ctx. ctx has to be reduced."


Add type hints

Add type hints

--- src/net/sekao/nightcode/editors.clj
+++ src/net/sekao/nightcode/editors.clj
@@ -116,13 +116,13 @@
 (fdef should-open?
   :args (s/cat :file spec/file?)
   :ret boolean?)
-(defn should-open? [file]
+(defn should-open? [^File file]
   (-> file .length (< max-file-size)))

 (fdef editor-pane
   :args (s/cat :runtime-state map? :file spec/file?)
   :ret spec/pane?)
-(defn editor-pane [runtime-state file]
+(defn editor-pane [runtime-state ^File file]
   (when (should-open? file)
     (let [pane (FXMLLoader/load (io/resource "editor.fxml"))
           buttons (-> pane .getChildren (.get 0) .getChildren seq)


CLJS-35 & CLJS-161: serve static resources from multiple locations.

This allows same configuration to support development and production
builds.

--- src/clj/cljs/repl/browser.clj
+++ src/clj/cljs/repl/browser.clj
@@ -182,15 +182,16 @@
 (defn send-static [opts conn {path :path :as request}]
   (if (and (:static-dir opts)
            (not= "/favicon.ico" path))
-    (try
-      (let [path     (if (= "/" path) "/index.html" path)
-            contents (slurp (str (:static-dir opts) path))]
-        (send-and-close conn 200 contents
+    (let [path   (if (= "/" path) "/index.html" path)
+          st-dir (:static-dir opts)]
+      (if-let [local-path (seq (for [x (if (string? st-dir) [st-dir] st-dir)
+                                     :when (.exists (io/file (str x path)))]
+                                 (str x path)))]
+        (send-and-close conn 200 (slurp (first local-path))
                         (condp #(.endsWith %2 %1) path
                           ".js" "text/javascript"
                           ".html" "text/html"
-                          "text/plain")))
-      (catch java.io.FileNotFoundException e
+                          "text/plain"))
         (send-404 conn path)))
     (send-404 conn path)))

@@ -338,7 +339,7 @@
                      :optimizations :simple
                      :working-dir   ".repl"
                      :serve-static  true
-                     :static-dir    "."}
+                     :static-dir    ["." "out/"]}
                     opts)]
     (do (swap! server-state
                (fn [old] (assoc old :client-js


add Archives requirement to :successful-run-ends event hook

--- src/clj/game/cards-events.clj
+++ src/clj/game/cards-events.clj
@@ -267,18 +267,21 @@
    {:effect (effect (run :archives nil card) (register-events (:events (card-def card))
                                                               (assoc card :zone '(:discard))))
     :events {:successful-run-ends
-             {:prompt "Choose a piece of ICE in Archives"
-              :choices (req (filter #(= (:type %) "ICE") (:discard corp)))
-              :effect (req (let [icename (:title target)]
-                             (resolve-ability
-                               state side
-                               {:prompt (msg "Choose a rezzed copy of " icename " to trash")
-                                :choices {:req #(and (= (:type %) "ICE")
-                                                     (:rezzed %)
-                                                     (= (:title %) icename))}
-                                :msg (msg "trash " icename " protecting " (zone->name (second (:zone target))))
-                                :effect (req (trash state :corp target))} card nil)
-                             (unregister-events state side card)))}}}
+             {:req (req (= target :archives))
+              :effect (effect (resolve-ability
+                                {:prompt "Choose a piece of ICE in Archives"
+                                 :choices (req (filter #(= (:type %) "ICE") (:discard corp)))
+                                 :effect (req (let [icename (:title target)]
+                                                (resolve-ability
+                                                  state side
+                                                  {:prompt (msg "Choose a rezzed copy of " icename " to trash")
+                                                   :choices {:req #(and (= (:type %) "ICE")
+                                                                        (:rezzed %)
+                                                                        (= (:title %) icename))}
+                                                   :msg (msg "trash " icename " protecting " (zone->name (second (:zone target))))
+                                                   :effect (req (trash state :corp target))} card nil)))}
+                               card nil)
+                              (unregister-events card))}}}

    "Indexing"
    {:effect (effect (run :rd {:replace-access


Expanding the time a thought remains open to 24 hours

12 hours is too short, and didn't consider that people might usually
write on Memento at a fixed time of the day.  May even go up to 48 hours
in the future.

--- src/clj/memento/db/memory.clj
+++ src/clj/memento/db/memory.clj
@@ -23,7 +23,7 @@
                        (:results memories))))

-(def open-duration (* 12 60 60 1000))
+(def open-duration (* 24 60 60 1000))

 (defn set-memory-status


fix deps.cljs not being handled correctly

--- src/clj/shadow/cljs/build.clj
+++ src/clj/shadow/cljs/build.clj
@@ -340,7 +340,7 @@
                     ;; remove :file or :file-min
                     (dissoc (get foreign-lib lib-other))
                     (assoc lib-name rc)))))
-          manifest
+          (dissoc manifest "deps.cljs")
           foreign-libs)))))


add basic input and list widget

add basic input and list widget

--- src/cljs/takarabako/core.cljs
+++ src/cljs/takarabako/core.cljs
@@ -1,9 +1,7 @@
 (ns takarabako.core
   (:require [konserve.memory :refer [new-mem-store]]
             [replikativ.peer :refer [client-peer]]
-            [replikativ.stage :refer [create-stage! connect!
-                                      subscribe-crdts!]]
-
+            [replikativ.stage :refer [create-stage! connect! subscribe-crdts!]]
             [hasch.core :refer [uuid]]
             [replikativ.crdt.ormap.realize :refer [stream-into-identity!]]
             [replikativ.crdt.ormap.stage :as s]
@@ -23,13 +21,15 @@

 (enable-console-print!)

+(defn pprint [s & args]
+  (.log js/console (apply pr-str s args)))

 (def stream-eval-fns
   {'assoc (fn [a new]
-            (swap! a assoc (uuid new) new)
+            (swap! a assoc-in [:transactions (uuid new)] new)
             a)
    'dissoc (fn [a new]
-             (swap! a dissoc (uuid new))
+             (swap! a update-in [:transactions] (fn [txs] (dissoc txs (uuid new))))
              a)})

@@ -54,6 +54,13 @@
              :stream stream
              :peer local-peer})))

+(declare client-state)
+
+(defn add-transaction! [app-state tx]
+  (s/assoc! (:stage client-state)
+            [user ormap-id]
+            (uuid tx)
+            [['assoc tx]]))

 (defn target-val [e]
   (.. e -target -value))
@@ -61,14 +68,64 @@
 (def reconciler
   (om/reconciler {:state val-atom}))

+(defn input-widget [component placeholder local-key type]
+  [:input {:value (get (om/get-state component) local-key)
+           :placeholder placeholder
+           :type type
+           :on-change (fn [e]
+                        (om/update-state! component assoc local-key (target-val e)))}])
+
+(defn transactions-widget [transactions]
+  [:div
+   [:h3 "Transactions"]
+   [:table
+    [:tr
+     [:th "Description"]
+     [:th "Date"]
+     [:th "Value"]]
+    (mapv
+     (fn [{:keys [description value date] :as tx}]
+       [:tr {:key (uuid tx)}
+        [:td description]
+        [:td (str (js/Date. date))]
+        [:td value]])
+     (sort-by :date > transactions))]])
+
 (defui App
   Object
+  (componentWillMount [this]
+    (om/set-state! this {:input-description "" :input-value nil}))
   (render [this]
-    (html [:h1 "Hello takarabako!"])))
+    (let [app-state (om/props this)
+          {:keys [input-description input-value]} (om/get-state this)]
+      (html
+       [:div
+        [:h3 "New Transaction"]
+        (input-widget this "Description" :input-description :text)
+        (input-widget this "Value" :input-value :number)
+        [:button
+         {:on-click (fn [e]
+                      (do
+                        (add-transaction!
+                         app-state
+                         {:description input-description
+                          :date (.getTime (js/Date.))
+                          :value input-value})
+                        (om/update-state! this assoc :input-value nil)
+                        (om/update-state! this assoc :input-description "")))}
+         "Add"]
+        (transactions-widget (vals (:transactions app-state)))]))))

 (defn main [& args]
-  #_(go-try S
+  (go-try S
           (def client-state (<? S (setup-replikativ)))
           (.error js/console "INITIATED")))

 (om/add-root! reconciler App (.getElementById js/document "app"))
+
+(comment
+
+  (get-in @val-atom [:input])
+  (vals (get-in @val-atom [:transactions]))
+
+  )


add some transducer juice

add some transducer juice

--- src/cljs/takarabako/core.cljs
+++ src/cljs/takarabako/core.cljs
@@ -88,6 +88,17 @@
       {:value value}
       {:value :not-found})))

+(defmethod read :transactions/list
+  [{:keys [state]} key {:keys [sort-key compare-fn]}]
+  (let [st @state]
+    (if-let [[_ txs] (find st :transactions)]
+      (let [process-tx (comp
+                        (map (fn [[k v]] (assoc v :id k)))
+                        (map (fn [tx] (update-in tx [:value]
+                                                 #(/ % 100)))))]
+        {:value (sort-by sort-key compare-fn (transduce process-tx conj [] txs))})
+      {:value []})))
+
 (def process-tx-value
   (comp (remove nil?)
         (map
@@ -137,12 +148,14 @@
       [:th "Description"]
       [:th "Value"]]
      (mapv
-      (fn [{:keys [description created value type date] :as tx}]
-        [:tr {:key (uuid tx)}
-         [:td (str (.toLocaleDateString (js/Date. created)))]
+      (fn [{:keys [id description created value type date] :as tx}]
+        [:tr {:key id}
+         [:td (-> created
+                  js/Date.
+                  .toLocaleDateString)]
          [:td description]
          [:td {:style {:color (if (= type :expense) "#F00" "#0F0")}} value]])
-      (sort-by :created > transactions))]]])
+      transactions)]]])

 (defn transaction-add-button [component]
@@ -154,7 +167,10 @@
                                   :created (.getTime (js/Date.))
                                         ;:date #_(.getTime input-date)
                                   :type (if input-type-toggle :expense :income)
-                                  :value input-value}]
+                                  :value (-> input-value
+                                             js/parseFloat
+                                             (* 100)
+                                             js/Math.round)}]
                       (do
                         (om/transact! component `[(transactions/add ~new-tx)])
                         (om/update-state! component assoc :input-value nil)
@@ -175,10 +191,10 @@
 (defui App
   static om/IQueryParams
   (params [this]
-    {:start-date (js/Date. 2016) :end-date (js/Date. 2017)})
+    {:start-date (js/Date. 2016) :end-date (js/Date. 2017) :sort-key :created :compare-fn >})
   static om/IQuery
   (query [this]
-    '[:transactions
+    '[(:transactions/list {:sort-key ?sort-key :compare-fn ?compare-fn})
       (:account/balance {:start-date ?start-date :end-date ?end-date})])
   Object
   (componentWillMount [this]
@@ -187,7 +203,7 @@
                          :input-date nil
                          :input-value nil}))
   (render [this]
-    (let [{:keys [account/balance transactions]} (om/props this)]
+    (let [{:keys [account/balance transactions/list]} (om/props this)]
       (html
        [:div
         [:div
@@ -201,9 +217,7 @@
          #_(input-widget this "Date" :input-date :time)
          (type-toggle-widget this)
          (transaction-add-button this)]
-        (transactions-widget
-         (if (= :not-found transactions) []
-             (vals transactions)))]))))
+        (transactions-widget list)]))))

 (defn main [& args]
@@ -248,6 +262,5 @@
    {:sum 0 :count 0}
    txs)

-  (transduce (map inc) mean-reducer {:sum 0 :count 0} (range 10))

   )


Circle symbol icons for google maps.

Circle symbol icons for google maps.

--- src/cljs/town_client/map.cljs
+++ src/cljs/town_client/map.cljs
@@ -14,8 +14,14 @@
   [id]
   (log "adding map ")
   (log id)
-  (let [map-opts (clj->js {"center" (google.maps.LatLng. lat lon)
-                           "zoom" 11})
+  (let [map-opts #js{"center" (google.maps.LatLng. lat lon)
+                     "zoom" 11
+                     "panControl" false
+                     "zoomControl" true
+                     "mapTypeControl" false
+                     "scaleControl" false
+                     "streetViewControl" false
+                     "overviewMapControl" false }
         el (sel1 (str ".map-ranking-content#" id " " ".g-mapcanvas"))
         map (google.maps.Map. el map-opts)]
     (swap! maps assoc id map)
@@ -28,10 +34,23 @@
 (defn color
   [key]
   (condp = key
-    "paikka-tai-alue-asuinrakentamiselle" "blue"
-    "alue-ei-ole-virkistykselle-valttamaton-paikalle-voisi-rakentaa" "red"
-    "green"
+   ;"#ef889d"
+
+    "paikka-tai-alue-asuinrakentamiselle" "#363636"
+    "alue-ei-ole-virkistykselle-valttamaton-paikalle-voisi-rakentaa" "#708f38"
+
+    "paikka-toimistoille-palveluille-tai-liiketiloille" "#363636"
+    "taalla-pitaisi-olla-enemman-kauppoja-ja-palveluita-rakennusten-kivijaloissa" "#990000"
+
+    "virkistyksellisesti-tarkea-mutta-saisi-olla-laadultaan-parempi" "#000099"
+    "taalla-on-tallaisenaan-ainutlaatuista-kaupunkiluontoa" "#363636"
+
+    "taalla-ymparisto-nayttaa-ankealta-ja-sita-pitaisi-parantaa-esimerkiksi-puuistutuksin" "#e2591b"
+    "huonosti-hoidettu-epamaarainen-alue-jota-tulisi-parantaa" "#363636"
+
+    "black"
     ))
+

 (defn add-data
   [data]
@@ -47,8 +66,12 @@
                    (fn [feature]
                      (let [text (.getProperty feature "text_content")
                            category (.getProperty feature "category")]
-                       (clj->js {:title (if (> (count text) 0) text category)
-                                 :icon (icon (color category))}))))))))
+                       #js{:title (if (> (count text) 0) text category)
+                           :icon #js{:path google.maps.SymbolPath.CIRCLE
+                                     :scale 3
+                                     :fillColor (color category)
+                                     :strokeWeight 0
+                                     :fillOpacity 1} })))))))

 (defn init
   []


Some cleanup

Some cleanup

--- src/clojure/picard/server.clj
+++ src/clojure/picard/server.clj
@@ -149,13 +149,13 @@
       (.options current-state)))
   ([keepalive-timeout-atom ch options]
      (clear-keepalive-timeout keepalive-timeout-atom)
-     (reset! keepalive-timeout-atom
-             (netty/on-timeout
-              global-timer (* (:keepalive options) 1000)
-              (fn []
-                (debug {:msg "Connection reached max keepalive time."
-                        :event ch})
-                (.close ch))))))
+     (reset!
+      keepalive-timeout-atom
+      (netty/on-timeout
+       global-timer (* (:keepalive options) 1000)
+       (fn []
+         (debug {:msg "Connection reached max keepalive time." :event ch})
+         (.close ch))))))

 (defn- write-msg
   [state current-state msg]
@@ -166,9 +166,10 @@

 (defn- write-last-msg
   [state current-state msg close-channel?]
-  (let [last-write (if msg
-                     (write-msg state current-state msg)
-                     (.last-write current-state))]
+  (let [last-write
+        (if msg
+          (write-msg state current-state msg)
+          (.last-write current-state))]
     (when close-channel?
       (.addListener last-write netty/close-channel-future-listener))))

@@ -196,14 +197,6 @@
             (debug {:msg "Killing connection" :state current-state})
             (write-last-msg state current-state last-msg true))))
       (write-last-msg state current-state last-msg false))))
-
-(defn- aborted-req
-  [_ evt val _]
-  (throw
-   (Exception.
-    (str "This request has been aborted.\n"
-         "  Event: " evt "\n"
-         "  Value: " val))))

 (defn- stream-or-finalize-response
   [state evt chunk current-state]
@@ -286,27 +279,24 @@

 (defn- handle-err
   [state err current-state]
-  (let [upstream (.upstream current-state)
-        channel  (.ch current-state)]
-
-    (debug {:msg "Handling error" :event err :state current-state})
-
-    (swap-then!
-     state
-     #(assoc % :aborting? true)
-     (fn [current-state]
+  (swap-then!
+   state
+   #(assoc % :aborting? true)
+   (fn [current-state]
+     (debug {:msg "Handling error" :event err :state current-state})
+     (let [channel (.ch current-state)]
        ;; Clear any timeouts for the current connection since we're
        ;; about to close it
        (clear-timeout state current-state)
+       (clear-keepalive-timeout (.keepalive-timeout current-state))

        (if-let [last-write (.last-write current-state)]
          (.addListener last-write netty/close-channel-future-listener)
-         (when channel (.close channel)))
-
-       ;; If there still is an upstream handler, send an abort message
-       (when upstream
-         (try (upstream :abort err)
-              (catch Exception _ nil)))))))
+         (when (.isOpen channel)
+           (.close channel)))
+
+       (try ((.upstream current-state) :abort err)
+            (catch Exception _ nil))))))

 (defn- mk-downstream-fn
   [state]


Added: Endpoint to give out the location of the server

--- src/gamlor/rochla/pages.clj
+++ src/gamlor/rochla/pages.clj
@@ -133,6 +133,9 @@
           )
         )
       )
+    (GET "/api/info/location" []
+      (rest/response (-> app :config :location))
+      )
     (context "/session" []
       (GET "/status" request
         (if-let [session (session request)]


trigger ci

trigger ci

--- main/src/dda/pallet/dda_managed_vm/infra/office.clj
+++ main/src/dda/pallet/dda_managed_vm/infra/office.clj
@@ -140,13 +140,10 @@

 (s/defn init-system
   "install common used packages for vm"
-  [facility config]
-  (actions/as-action
-    (logging/info (str facility "-office: init system")))
-  (let [{:keys [settings fakturama]} config]
-    (when (contains? settings :install-pdf-chain)
-      (init-pdftk facility))
-    ))
+  [facility settings]
+  (when (contains? settings :install-pdf-chain)
+    (init-pdftk facility))
+    )

 (s/defn install-system
   "install common used packages for vm"


support passing a map of options to defmetricsconsumer, and add parallelism hint option

--- src/clj/marceline/storm/metrics.clj
+++ src/clj/marceline/storm/metrics.clj
@@ -4,34 +4,36 @@
 	    [backtype.storm.config :refer (TOPOLOGY-METRICS-CONSUMER-REGISTER)])
   (:gen-class))

-;; TODO allow params
-;; TODO make cleanup optional
 (defmacro defmetricsconsumer
-  [name prepare-impl handle-data-points-impl & [cleanup-impl?]]
-  (let [prefix (gensym)
-	classname (str *ns* ".consumer." name)
-	state "state"
-	init "init"
-        cleanup-impl (or cleanup-impl? `([_#]))]
-    `(do
-       (gen-class :name ~classname
-		  :implements [backtype.storm.metric.api.IMetricsConsumer]
-		  :prefix ~prefix
-		  :state ~state
-		  :init ~init)
-       (defn ~(symbol (str prefix "init"))
-	 []
-	 [[] (atom {})])
-       (defn ~(symbol (str prefix "prepare"))
-	 ~@prepare-impl)
-       (defn ~(symbol (str prefix "handleDataPoints"))
-	 ~@handle-data-points-impl)
-       (defn ~(symbol (str prefix "cleanup"))
-	 ~@cleanup-impl)
-       (def ~name {~TOPOLOGY-METRICS-CONSUMER-REGISTER
-		   [{"class" ~classname
-		     "parallelism.hint" 1
-		     "argument" nil}]}))))
+  [name & [opts & impl :as all]]
+  (if-not (map? opts)
+    `(defmetricsconsumer ~name {} ~@all)
+    (let [prefix (gensym)
+          classname (str *ns* ".consumer." name)
+          state "state"
+          init "init"
+          [prepare-impl handle-data-points-impl & [cleanup-impl?]] impl
+          cleanup-impl (or cleanup-impl? `([_#]))
+          parallelism (:p opts 1)]
+      `(do
+         (gen-class :name ~classname
+                    :implements [backtype.storm.metric.api.IMetricsConsumer]
+                    :prefix ~prefix
+                    :state ~state
+                    :init ~init)
+         (defn ~(symbol (str prefix "init"))
+           []
+           [[] (atom {})])
+         (defn ~(symbol (str prefix "prepare"))
+           ~@prepare-impl)
+         (defn ~(symbol (str prefix "handleDataPoints"))
+           ~@handle-data-points-impl)
+         (defn ~(symbol (str prefix "cleanup"))
+           ~@cleanup-impl)
+         (def ~name {~TOPOLOGY-METRICS-CONSUMER-REGISTER
+                     [{"class" ~classname
+                       "parallelism.hint" ~parallelism
+                       "argument" nil}]})))))

 (defmacro defmetric
   [get-value-and-reset-impl]


hide endorse link from badge owner

hide endorse link from badge owner

--- src/cljs/salava/badge/ui/modal.cljs
+++ src/cljs/salava/badge/ui/modal.cljs
@@ -210,7 +210,7 @@
         (check-badge id)

         ;;Endorse-badge
-        (when-not owner? (endr/endorse-badge id))
+        (when-not owner? [endr/endorse-badge id])
         ]]

       (when-not (empty? alignment)


material comment

material comment

--- src/clojure2d/extra/raymarching.clj
+++ src/clojure2d/extra/raymarching.clj
@@ -14,6 +14,23 @@

 (deftype Material [^Vec3 color diffusion specular specularf0 specularpow reflection])
 (deftype HitData [d ^Material mat])
+
+(defn make-material
+  "Create material information:
+  - color - Vec3 with RGB: 0.0-1.0
+  - diffusion - diffusion ratio: 0.0 - 1.0
+  - specular - specular ratio: 0.0 - 1.0
+  - specularf0 - f0, intensity ratio: 0.0 - 1.0
+  - specularpow - strength of specular: 1.0 - 10k
+  - reflection - reflection ratio: 0.0 - 1.0"
+  [conf]
+  (Material. (:color conf)
+             (:diffusion conf)
+             (:specular conf)
+             (:specularf0 conf)
+             (:specularpow conf)
+             (:reflection conf)))
+

 (defn interpolate-material
   ""


Clean up (close #35)

Clean up (close #35)

--- src/infoq_podcast/cache.clj
+++ src/infoq_podcast/cache.clj
@@ -27,7 +27,6 @@
   (db/create-table db-spec :presentations
                    [:id :TEXT "PRIMARY KEY" "NOT NULL"]
                    [:creation_date :DATETIME "NOT NULL" "DEFAULT CURRENT_TIMESTAMP"]
-                 ;;[:creation_date :DATETIME "NOT NULL" "DEFAULT (datetime ('now','localtime'))"]
                    [:publish_date :DATETIME "NOT NULL"]
                    [:data :BLOB "NOT NULL"]))


Construct a scaling function and apply it to the notes separately.

--- src/klangmeister/graph.cljs
+++ src/klangmeister/graph.cljs
@@ -1,18 +1,22 @@
 (ns klangmeister.graph
   (:require
     [leipzig.melody :as melody]
+    [leipzig.scale :as scale]
+    [leipzig.temperament :as temperament]
     [quil.core :as quil :include-macros true]
     [quil.middleware :as middleware]
     [reagent.core :as reagent]))

-(defn scale [k to ms]
-  (let [maximum (->> ms (map k) (apply max))
-        minimum (->> ms (map k) (apply min))
-        range (- maximum minimum)]
-    (->> ms
-         (melody/where k #(- % minimum))
-         (melody/where k #(/ % range))
-         (melody/where k #(* % to)))))
+(defn scaler-for [to values]
+  (let [maximum (apply max values)
+        minimum (apply min values)
+        spread (- maximum minimum)]
+    (fn [x] (-> x (- minimum) (/ spread) (* to)))))
+
+(def guide-frequencies
+  (map (comp temperament/equal scale/C scale/major) (range -10 10)))
+
+(js/console.log (apply print-str guide-frequencies))

 (defn draw-graph [state-atom]
   (let [[height width] [150 800]
@@ -25,9 +29,14 @@
                                                 (melody/wherever
                                                   #(and looping? (<= (:time %) relative-time))
                                                   :played? (melody/is true)))
+                                    scale-pitch (scaler-for (- height dot-height) (map :pitch music))
+                                    scale-time (scaler-for (- width dot-width) (map :time music))
                                     scaled (->> marked
-                                                (scale :time (- width dot-width))
-                                                (scale :pitch (- height dot-height)))]
+                                                (melody/where :pitch scale-pitch)
+                                                (melody/where :time scale-time))]
+                                #_(doseq [freq (map scale-pitch guide-frequencies)]
+                                  (quil/stroke 200)
+                                  (quil/line 0 (* 0.5 freq) width (* 0.5 freq)))
                                 (doseq [{:keys [time pitch played?]} scaled]
                                   (let [colour (if played? 200 20)
                                         half (partial * 0.5)


minor refactoring

minor refactoring

--- src/leiningen/fore_prob.clj
+++ src/leiningen/fore_prob.clj
@@ -40,16 +40,17 @@
 (defn- strip-html
   "strip HTML tags from a string"
   [html]
-  (->
-    html
-    ;; Jsoup doesn’t preserve newlines, we’re using a little trick inspired
-    ;; of http://stackoverflow.com/a/6031463/735926 -- we replace newlines with
-    ;; a special word, strip HTML then replace each special word back to a
-    ;; newline.
-    (cs/replace #"(?i)(?:<br[^>]*>|\r?\n)\s*" "xZ%q9a")
-    (soup/parse)
-    .text
-    (cs/replace #"xZ%q9a" "\n")))
+  ;; Jsoup doesn’t preserve newlines, we’re using a little trick inspired
+  ;; of http://stackoverflow.com/a/6031463/735926 -- we replace newlines with
+  ;; a special word, strip HTML then replace each special word back to a
+  ;; newline.
+  (let [special-word "xZ%q9a"]
+    (->
+      html
+      (cs/replace #"(?i)(?:<br[^>]*>|\r?\n)\s*" special-word)
+      (soup/parse)
+      .text
+      (cs/replace (re-pattern special-word) "\n"))))

 (defn- desc->comments


defonce all the atoms

defonce all the atoms

--- Assets/game/data.clj
+++ Assets/game/data.clj
@@ -1,13 +1,13 @@
 (ns game.data)

 (defonce seed (atom 0))
-(def skater-name (atom ""))
-(def player (atom nil))
+(defonce skater-name (atom ""))
+(defonce player (atom nil))
 (defonce player-spawned? (atom false))
-(def skin-color (atom nil))
+(defonce skin-color (atom nil))
 (defonce respawn-fn (atom #()))
 (defonce selection-fn (atom #()))
-(def recording? (atom false))
+(defonce recording? (atom false))

 (def first-names
  ["alfred"


Refactored compojure.http.routes to use Clout

--- src/compojure/http/routes.clj
+++ src/compojure/http/routes.clj
@@ -10,161 +10,31 @@
   "Macros and functions for compiling routes in the form (method path & body)
    into stand-alone functions that return the return value of the body, or the
    keyword :next if they don't match."
-  (:use compojure.http.request)
+  (:use clout)
+  (:use compojure.control)
   (:use compojure.http.response)
-  (:use compojure.http.session)
-  (:use compojure.str-utils)
-  (:use compojure.map-utils)
-  (:use compojure.control)
-  (:use compojure.encodings)
-  (:import java.util.regex.Pattern)
-  (:import java.util.Map))
+  (:use compojure.http.request))

-;; Functions for lexing a string
-
-(defn- lex-1
-  "Lex one symbol from a string, and return the symbol and trailing source."
-  [src clauses]
-  (some
-    (fn [[re action]]
-      (let [matcher (re-matcher re src)]
-        (if (.lookingAt matcher)
-          [(if (fn? action) (action matcher) action)
-           (.substring src (.end matcher))])))
-    (partition 2 clauses)))
-
-(defn- lex
-  "Lex a string into tokens by matching against regexs and evaluating
-   the matching associated function."
-  [src & clauses]
-  (loop [results []
-         src     src
-         clauses clauses]
-    (if-let [[result src] (lex-1 src clauses)]
-      (let [results (conj results result)]
-        (if (= src "")
-          results
-          (recur results src clauses))))))
-
-;; Functions for matching URIs using a syntax borrowed from Ruby frameworks
-;; like Sinatra and Rails.
-
-(defstruct uri-matcher
-  :regex
-  :keywords)
-
-(defn compile-uri-matcher
-  "Compile a path string using the routes syntax into a uri-matcher struct."
-  [path]
-  (let [splat   #"\*"
-        word    #":([A-Za-z][\w-]*)"
-        literal #"(:[^A-Za-z*]|[^:*])+"]
-    (struct uri-matcher
-      (re-pattern
-        (apply str
-          (lex path
-            splat   "(.*?)"
-            word    "([^/.,;?]+)"
-            literal #(re-escape (.group %)))))
-      (vec
-        (remove nil?
-          (lex path
-            splat   :*
-            word    #(keyword (.group % 1))
-            literal nil))))))
-
-;; Don't compile paths more than once.
-(decorate-with memoize compile-uri-matcher)
-
-(defmulti compile-matcher
-  "Compile a string or regex into a form suitable for buing passed to the
-  match-uri function."
-  class)
-
-(defmethod compile-matcher String
-  [path]
-  (compile-uri-matcher path))
-
-(defmethod compile-matcher Pattern
-  [re]
-  re)
-
-(defn- assoc-keywords-with-groups
-  "Create a hash-map from a series of regex match groups and a collection of
-  keywords."
-  [groups keywords]
-  (reduce
-    (fn [m [k v]] (assoc-vec m k v))
-    {}
-    (map vector keywords groups)))
-
-(defmulti match-uri
-  "Match a URL against a compiled URI-matcher or a regular expression. Returns
-  the matched URI keywords as a map, or the matched regex groups as a vector."
-  (fn [matcher uri] (class matcher)))
-
-(defmethod match-uri Map
-  [uri-matcher uri]
-  (let [matcher (re-matcher (uri-matcher :regex) (or uri "/"))]
-    (if (.matches matcher)
-      (assoc-keywords-with-groups
-        (map urldecode (re-groups* matcher))
-        (uri-matcher :keywords)))))
-
-(defmethod match-uri Pattern
-  [uri-pattern uri]
-  (let [matches (re-matches uri-pattern (or uri "/"))]
-    (if matches
-      (if (vector? matches)
-        (vec (map urldecode (rest matches)))
-        []))))
-
-(defn match-method
+(defn method-matches
   "True if this request matches the supplied method."
   [method request]
   (let [request-method (request :request-method)
         form-method    (-> request :form-params :_method)]
     (or (nil? method)
         (if (and form-method (= request-method :post))
-          (= (upcase-name method) form-method)
+          (= (.toUpperCase (name method)) form-method)
           (= method request-method)))))

-(defn request-url
-  "Return the complete URL for the request."
-  [request]
-  (str
-    (name (:scheme request))
-    "://"
-    (get-in request [:headers "host"])
-    (:uri request)))
-
-(defn absolute-url?
-  "True if the string is an absolute URL."
-  [s]
-  (re-find #"^[a-z+.-]+://" s))
-
-(defn get-matcher-uri
-  "Get the appropriate request URI for the given path pattern."
-  [path request]
-  (if (and (string? path) (absolute-url? path))
-    (request-url request)
-    (:uri request)))
-
-(defmacro request-matcher
+(defn- request-matcher
   "Compiles a function to match a HTTP request against the supplied method
-  and path template. Returns a map of the route parameters if the is a match,
-  nil otherwise. Precompiles the route when supplied with a literal string."
-  [method path]
-  (let [matcher (if (or (string? path) (instance? Pattern path))
-                  (compile-matcher path)
-                 `(compile-matcher ~path))]
+  and route."
+  [method route]
+  (let [matcher (if (string? route)
+                  (route-compile route)
+                  route)]
    `(fn [request#]
-      (and
-        (match-method ~method request#)
-        (match-uri ~matcher (get-matcher-uri ~path request#))))))
-
-;; Functions and macros for generating routing functions. A routing function
-;; returns :next if it doesn't match, and any other value if it does.
+      (and (method-matches ~method request#)
+           (route-matches ~route request#)))))

 (defmacro with-request-bindings
   "Add shortcut bindings for the keys in a request map."
@@ -187,7 +57,7 @@
 (defn compile-route
   "Compile a route in the form (method path & body) into a function."
   [method path body]
-  `(let [matcher# (request-matcher ~method ~path)]
+  `(let [matcher# ~(request-matcher method path)]
      (fn [request#]
        (if-let [route-params# (matcher# request#)]
          (let [request# (assoc-route-params request# route-params#)]


shorter tmpfile names

shorter tmpfile names

--- boot/core/src/boot/tmpregistry.clj
+++ boot/core/src/boot/tmpregistry.clj
@@ -15,7 +15,7 @@
 ;; helpers

 (defn munged-file [dir kw & n]
-  (apply io/file dir (->> kw hash (format "%x")) (remove nil? n)))
+  (apply io/file dir (-> kw hash (Integer/toString 36)) (remove nil? n)))

 (defn delete! [f]
   (let [delete (io/file f)]
@@ -24,10 +24,12 @@

 (defn pid! []
   (format "%s-%s"
-    (->> (.. ManagementFactory getRuntimeMXBean getName)
-      (take-while (partial not= \@))
-      (apply str))
-    (str @pod/pod-id)))
+    (-> (->> (.. ManagementFactory getRuntimeMXBean getName)
+          (take-while (partial not= \@))
+          (apply str)
+          Long/parseLong)
+      (Long/toString 36))
+    (Long/toString @pod/pod-id 36)))

 (defn mark-delete-me! [dir]
   #(when (.exists dir) (.createNewFile (io/file dir ".delete-me"))))


RR: include leaflet css

RR: include leaflet css

--- src/clj/ona/viewer/views/template.clj
+++ src/clj/ona/viewer/views/template.clj
@@ -2,24 +2,26 @@
   (:require [hiccup.page :refer [html5]]
             [ona.utils.tags :as tags]))

-(def style-sheets
+(def default-css
   (map #(str "/css/" %)
        ["normalize.css"
         "font-awesome.min.css"
         "pure-min.css"
         "style.css"
         "font-awesome.min.css"
-        "proxima-nova.css"
-        "slick.grid.css"
-        "slick-default-theme.css"]))
+        "proxima-nova.css"]))

 (defn base
   [title content & js]
   (html5
   [:head
    [:title title]
-   (for [style-sheet style-sheets]
+   (for [style-sheet default-css]
      [:link {:rel "stylesheet" :type "text/css" :href style-sheet}])]
+  [:link {:rel  "stylesheet"
+          :href "//cdnjs.cloudflare.com/ajax/libs/leaflet/0.7.3/leaflet.css"}]
+  [:link {:rel  "stylesheet" :href "/css/slick.grid.css"}]
+  [:link {:rel  "stylesheet" :href "/css/slick-default-theme.css"}]
   [:body
    [:content {:class "wrapper cfix"}
     [:div {:id "app"}


Eliminate potential memory leak from jline logger

--- src/clj/reply/reader/simple_jline.clj
+++ src/clj/reply/reader/simple_jline.clj
@@ -22,15 +22,18 @@
     (.restore (.getTerminal reader))
     (.shutdown reader)))

+(defn null-output-stream []
+  (proxy [java.io.OutputStream] []
+    (write [b])))
+
 (defn- initialize-jline []
   (.addShutdownHook (Runtime/getRuntime)
                     (Thread. #(when-let [reader @current-console-reader]
                                 (shutdown reader))))
   (when (= "dumb" (System/getenv "TERM"))
     (.setProperty (Configuration/getProperties) "jline.terminal" "none"))
-  ;; TODO: what happens when nobody consumes from this stream?
   (when-not (System/getenv "JLINE_LOGGING")
-    (Log/setOutput (PrintStream. (ByteArrayOutputStream.)))))
+    (Log/setOutput (PrintStream. (null-output-stream)))))

 (defn- prepare-for-next-read [{:keys [reader] :as state}]
   (.flush (.getHistory reader))


Display multiple SO tags correctly

Display multiple SO tags correctly

--- src/cljs/zest/docs/stackoverflow.cljs
+++ src/cljs/zest/docs/stackoverflow.cljs
@@ -21,7 +21,7 @@
     [process-tags
      (fn [tags]
        (if tags (.map
-                  (.match tags #"<[^>]+>")
+                  (.match tags (js/RegExp. "<[^>]+>" "g"))
                   #(.substring % 1 (- (.-length %) 1)))))

      process-answer


Add hover to display line violations

Add hover to display line violations

--- src/lt/plugins/rubocop.cljs
+++ src/lt/plugins/rubocop.cljs
@@ -17,10 +17,22 @@

 (defui cop-marker [cops]
   [:div.rubocop-gutter-marker
-   {:style (str " color: blue; background: #ffffff; overflow: hidden")
-    :title (clojure.string/join "\n" cops)}
    [:div.cop-gutter-dot
-    {:style "width: 8px; height: 10px; background: red;"}]])
+    {:style "width: 8px; height: 10px; background: red;"}]
+   [:div.cops
+    {:style "display:none;width: 310px; background:var(bg); padding: 5px; left: 10px; top: -1px; position: absolute;"
+     :class "cm-variable"}
+    [:ul
+     (map (fn [c]
+            [:li
+             {:style "padding-bottom: 3px; display:block"}
+             (str "- " c)]) cops)]]]
+  :mouseover (fn [e]
+               (if-let [target (dom/next (.-target e))]
+                 (dom/set-css target {:display :block})))
+  :mouseout (fn [e]
+               (if-let [target (dom/next (.-target e))]
+                 (dom/set-css target {:display :none}))))

 (defn violations-for-file [json-str]
   (let [parsed (js->clj (JSON/parse json-str))]


Couple of rect utils

Couple of rect utils

--- src/flatgui/util/rectmath.clj
+++ src/flatgui/util/rectmath.clj
@@ -92,8 +92,8 @@
     (fully-contains? b a)
     b
     :else
-    (let [h-inter (rectmath/line& (:x a) (+ (:x a) (:w a)) (:x b) (+ (:x b) (:w b)))
-          v-inter (rectmath/line& (:y a) (+ (:y a) (:h a)) (:y b) (+ (:y b) (:h b)))
+    (let [h-inter (line& (:x a) (+ (:x a) (:w a)) (:x b) (+ (:x b) (:w b)))
+          v-inter (line& (:y a) (+ (:y a) (:h a)) (:y b) (+ (:y b) (:h b)))
           v-edge (and (nil? v-inter) (or
                                        (= (:y b) (+ (:y a) (:h a)))
                                        (= (:y a) (+ (:y b) (:h b)))))]


Add inactive tab messages for charts

Add inactive tab messages for charts

Signed-off-by: Njagi Mwaniki <b6a4ba60ad861b9c9afb6daea7294be4be68f44c@urbanslug.com>

--- src/hatti/views/dataview.cljs
+++ src/hatti/views/dataview.cljs
@@ -63,7 +63,11 @@
          :photos (str "The Photos tab is disabled because this form has no "
                       "photo questions.")
          :table (str "The table tab is disabled because you do not have "
-                     "permissions to view it.")
+                     "permission to view it.")
+         :chart (str "The charts tab is disabled because you do not have "
+                     "permission to view it.")
+         :saved-charts (str "The dashboards tab is disabled because "
+                            "you do not have permission to view it.")
          "This tab is disabled."))]
     [:span.tip-question "?"]]])


Prep for indexing.

Prep for indexing.

--- src/org/scode/sob/repos.clj
+++ src/org/scode/sob/repos.clj
@@ -50,6 +50,10 @@
       (logging/info (str "picked up: " ret))
       (conj ret html))))

+(defn- index
+  [pages]
+  nil)
+
 (defn- make-page
   [f]
   (logging/info (str "processing new or possibly changed post " f))
@@ -99,9 +103,11 @@
       (if (> last-modified (:scan-checkpoint repos))
         (do
           (logging/info (str "repos changed: " (:path repos)))
-          (conj repos
-                [:pages (scan-pages dir (:pages repos))]
-                [:scan-checkpoint (dec now)]))
+          (let [new-pages (scan-pages dir (:pages repos))]
+            (conj repos
+                  [:pages new-pages]
+                  [:scan-checkpoint (dec now)]
+                  [:index (index new-pages)])))
         repos))))

 (defn maybe-scan


add daf-bass synth (http://sccode.org/1-J)

--- src/overtone/inst/synth.clj
+++ src/overtone/inst/synth.clj
@@ -146,6 +146,14 @@
         filt (resonz (rlpf src (* 4.4 freq) 0.09) (* 2.0 freq) 2.9)]
     (* env amp (fold:ar (distort (* 1.3 (+ filt sub))) 0.08))))

+(definst daf-bass [freq 440 gate 1 amp 1 out-bus 0]
+  (let [harm [1 1.01 2 2.02 3.5 4.01 5.501]
+        harm (concat harm (map #(* 2 %) harm))
+        snd  (* 2 (distort (sum (sin-osc (* freq harm)))))
+        snd  (+ snd (repeat 2 (sum (sin-osc (/ freq [1 2])))))
+        env  (env-gen (adsr 0.001 0.2 0.9 0.25) gate amp :action FREE)]
+    (* snd env)))
+
 (definst grunge-bass
   [note 48 amp 0.5 dur 0.1 a 0.01 d 0.01 s 0.4 r 0.01]
   (let [freq (midicps note)


add users to list of admin pages

add users to list of admin pages

--- src/pc/http/admin/inner.clj
+++ src/pc/http/admin/inner.clj
@@ -24,6 +24,7 @@
   (hiccup/html (content/layout {}
                                [:div {:style "padding: 40px"}
                                 [:div [:a {:href "/teams"} "Teams"]]
+                                [:div [:a {:href "/users"} "Users"]]
                                 [:div [:a {:href "/early-access"} "Early Access"]]
                                 [:div [:a {:href "/graphs"} "User Graphs"]]
                                 [:div [:a {:href "/clients"} "Clients"]]


Add comment to help in tracking down bug

--- src/day8/re_frame_10x/view/event.cljs
+++ src/day8/re_frame_10x/view/event.cljs
@@ -137,6 +137,7 @@
                after            (subs form-str end-index)]
            ;(println ">> event-expression:" (pr-str (subs (pr-str highlighted-form) 0 30)))
            ; DC: We get lots of React errors if we don't force a creation of a new element when the highlight changes. Not really sure why...
+           ;; Possibly relevant? https://stackoverflow.com/questions/21926083/failed-to-execute-removechild-on-node
            ^{:key (pr-str highlighted-form)}
            [rc/box
             :style {:max-height       (str (* 10 17) "px")  ;; Add scrollbar after 10 lines


Temp working point

Temp working point

--- src/day8/re_frame/trace/subvis.cljs
+++ src/day8/re_frame/trace/subvis.cljs
@@ -95,7 +95,7 @@

 (defn force-inner [graph]
   (r/create-class
-    {:reagent-render     (fn [] [:div [:svg {:width width :height height}]])
+    {:reagent-render       (fn [] [:div [:svg {:width width :height height}]])

      :component-did-mount  (fn []
                              (let [nodes       (clj->js (:nodes graph))
@@ -218,8 +218,8 @@
 (defonce desc (r/atom 1))

 (defn render-subvis [traces-ratom]
-  (let [color-a (atom nil)
-        svg-a (atom nil)
+  (let [color-a      (atom nil)
+        svg-a        (atom nil)
         simulation-a (atom nil)]
     (fn []
       [:div
@@ -228,180 +228,185 @@
        [force-outer traces-ratom]
        [:hr]
        [:h2 {:on-click #(swap! desc inc)} "Click"]
-       [(d3t/create-d3 {:render-component (fn [ratom]
-                                            [:div
-                                             [:h1 (str "SVG")]
-                                             [:svg#d3cmp {:width width :height height}]])
-                        :d3-did-mount     (fn [ratom]
-                                            (let [graph       (trace->sub-graph @ratom)
-                                                  nodes       (clj->js (:nodes graph))
-                                                  links       (clj->js (:links graph))
-                                                  color       (reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3)))
-                                                  svg         (reset! svg-a (. js/d3 select "#d3cmp"))
-                                                  simulation  (reset! simulation-a
-                                                                      (.. js/d3
-                                                                          (forceSimulation)
-                                                                          (force "link" (.. js/d3 (forceLink)
-                                                                                (id #(.-id %))
-                                                                                (distance (constantly 100))))
-                                                                          (force "charge" (.. js/d3 (forceManyBody)
-                                                                                (strength (constantly -100))))
-                                                                          (force "center" (. js/d3 forceCenter (/ width 2) (/ height 2)))))
-
-                                                  dragstarted (fn [d]
-                                                                (when (zero? (.. js/d3 -event -active))
-                                                                  (.. simulation
-                                                                      (alphaTarget 0.3)
-                                                                      (restart)))
-
-                                                                (set! (.-fx d) (.-x d))
-                                                                (set! (.-fy d) (.-y d)))
-
-                                                  dragged     (fn [d]
-                                                                (set! (.-fx d) (.. js/d3 -event -x))
-                                                                (set! (.-fy d) (.. js/d3 -event -y)))
-
-                                                  dragended   (fn [d]
-                                                                (when (zero? (.. js/d3 -event -active))
-                                                                  (.. simulation
-                                                                      (alphaTarget 0.0)))
-                                                                (set! (.-fx d) nil)
-                                                                (set! (.-fy d) nil))
-
-                                                  link        (.. (. svg append "g")
-                                                                  (attr "class" "links")
-                                                                  (selectAll "line")
-                                                                  (data links)
-                                                                  (enter)
-                                                                  (append "line")
-                                                                  (attr "stroke-width" (fn [d] (Math/sqrt (.-value d))))
-                                                                  )
-
-                                                  link-sel    (.. svg
-                                                                  (selectAll ".links > line"))
-
-                                                  node        (.. (. svg append "g")
-                                                                  (attr "class" "nodes")
-                                                                  (selectAll "circle")
-                                                                  (data nodes)
-                                                                  (enter)
-                                                                  (append "g")
-                                                                  (attr "class" "node"))
-
-                                                 circle      (.. node
-                                                                  (append "circle")
-                                                                  (attr "r" #(or (gob/get % "r" 10)))
-                                                                  (attr "fill" (fn [d] (color (.-group d))))
-                                                                  (call (.. (. js/d3 drag)
-                                                                            (on "start" dragstarted)
-                                                                            (on "drag" dragged)
-                                                                            (on "end" dragended))))
-
-                                                  circle-sel  (.. svg
-                                                                  (selectAll ".node > circle"))
-
-                                                  label       (.. node
-                                                                  (append "text")
-                                                                  (attr "dy" ".35em")
-                                                                  (text #(gob/get % "title" "")))
-
-                                                  label-sel   (.. svg
-                                                                  (selectAll ".node > text"))
-
-                                                  ticked      (fn []
-                                                                (.. link-sel
-                                                                    (attr "x1" (fn [d] (.. d -source -x)))
-                                                                    (attr "y1" (fn [d] (.. d -source -y)))
-                                                                    (attr "x2" (fn [d] (.. d -target -x)))
-                                                                    (attr "y2" (fn [d] (.. d -target -y))))
-                                                                (.. circle-sel
-                                                                    (attr "cx" (fn [d] (min-max (.. d -r) (.. d -x) (- width (.. d -r)))))
-                                                                    (attr "cy" (fn [d] (min-max (.. d -r) (.. d -y) (- height (.. d -r))))))
-                                                                (.. label-sel
-                                                                    (attr "x" #(+ (.-x %) 2 (.-r %)))
-                                                                    (attr "y" #(+ (.-y %))))
-                                                                nil)
-                                                  ]
-
-                                              (.. simulation
-                                                  (nodes nodes)
-                                                  (on "tick" ticked))
-
-                                              (.. simulation
-                                                  (force "link")
-                                                  (links links))))
-                       :d3-enter         (fn [ratom]
-                                            (let [graph       (trace->sub-graph @ratom)
-                                                  nodes       (clj->js (:nodes graph))
-                                                  links       (clj->js (:links graph))
-
-                                                  svg @svg-a
-                                                  color @color-a
-                                                  simulation @simulation-a
-
-                                                  dragstarted (fn [d]
-                                                                (when (zero? (.. js/d3 -event -active))
-                                                                  (.. simulation
-                                                                      (alphaTarget 0.3)
-                                                                      (restart)))
-
-                                                                (set! (.-fx d) (.-x d))
-                                                                (set! (.-fy d) (.-y d)))
-
-                                                  dragged     (fn [d]
-                                                                (set! (.-fx d) (.. js/d3 -event -x))
-                                                                (set! (.-fy d) (.. js/d3 -event -y)))
-
-                                                  dragended   (fn [d]
-                                                                (when (zero? (.. js/d3 -event -active))
-                                                                  (.. simulation
-                                                                      (alphaTarget 0.0)))
-                                                                (set! (.-fx d) nil)
-                                                                (set! (.-fy d) nil))
-
-                                                  link        (.. (. svg append "g")
-                                                                  (attr "class" "links")
-                                                                  (selectAll "line")
-                                                                  (data links)
-                                                                  (enter)
-                                                                  (append "line")
-                                                                  (attr "stroke-width" (fn [d] (Math/sqrt (.-value d)))))
-
-                                                  node        (.. (. svg append "g")
-                                                                  (attr "class" "nodes")
-                                                                  (selectAll "circle")
-                                                                  (data nodes)
-                                                                  (enter)
-                                                                  (append "g")
-                                                                  (attr "class" "node"))
-
-                                                  circle      (.. node
-                                                                  (append "circle")
-                                                                  (attr "r" #(or (gob/get % "r" 10)))
-                                                                  (attr "fill" (fn [d] (color (.-group d))))
-                                                                  (call (.. (. js/d3 drag)
-                                                                            (on "start" dragstarted)
-                                                                            (on "drag" dragged)
-                                                                            (on "end" dragended))))
-
-
-                                                  label       (.. node
-                                                                  (append "text")
-                                                                  (attr "dy" ".35em")
-                                                                  (text #(gob/get % "title" "")))
-
-                                                  ]
-
-                                              (.. simulation
-                                                  (force "link")
-                                                  (links links))
-                                              )
-
-
-
-
-                                            (println "D3 did enter"))}
-                       traces-ratom)]
+       [(d3t/create-d3
+          {:render-component (fn [ratom]
+                               [:div
+                                [:h1 (str "SVG")]
+                                [:svg#d3cmp {:width width :height height}]])
+           :d3-did-mount     (fn [ratom]
+                               (let [graph       (trace->sub-graph @ratom)
+                                     nodes       (clj->js (:nodes graph))
+                                     links       (clj->js (:links graph))
+                                     color       (reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3)))
+                                     svg         (reset! svg-a (. js/d3 select "#d3cmp"))
+                                     simulation  (reset! simulation-a
+                                                         (.. js/d3
+                                                             (forceSimulation)
+                                                             (force "link" (.. js/d3 (forceLink)
+                                                                               (id #(.-id %))
+                                                                               (distance (constantly 100))))
+                                                             (force "charge" (.. js/d3 (forceManyBody)
+                                                                                (strength (constantly -100))))
+                                                             (force "center" (. js/d3 forceCenter (/ width 2) (/ height 2)))))
+
+                                     dragstarted (fn [d]
+                                                   (when (zero? (.. js/d3 -event -active))
+                                                     (.. simulation
+                                                         (alphaTarget 0.3)
+                                                         (restart)))
+
+                                                   (set! (.-fx d) (.-x d))
+                                                   (set! (.-fy d) (.-y d)))
+
+                                     dragged     (fn [d]
+                                                   (set! (.-fx d) (.. js/d3 -event -x))
+                                                   (set! (.-fy d) (.. js/d3 -event -y)))
+
+                                     dragended   (fn [d]
+                                                   (when (zero? (.. js/d3 -event -active))
+                                                     (.. simulation
+                                                         (alphaTarget 0.0)))
+                                                   (set! (.-fx d) nil)
+                                                   (set! (.-fy d) nil))
+
+                                     link        (.. (. svg append "g")
+                                                     (attr "class" "links")
+                                                     (selectAll "line")
+                                                     (data links)
+                                                     (enter)
+                                                     (append "line")
+                                                     (attr "stroke-width" (fn [d] (Math/sqrt (.-value d))))
+                                                     )
+
+
+                                     node        (.. (. svg append "g")
+                                                     (attr "class" "nodes")
+                                                     (selectAll "circle")
+                                                     (data nodes)
+                                                     (enter)
+                                                     (append "g")
+                                                     (attr "class" "node"))
+
+                                     circle      (.. node
+                                                     (append "circle")
+                                                     (attr "r" #(or (gob/get % "r" 10)))
+                                                     (attr "fill" (fn [d] (color (.-group d))))
+                                                     (call (.. (. js/d3 drag)
+                                                               (on "start" dragstarted)
+                                                               (on "drag" dragged)
+                                                               (on "end" dragended))))
+
+
+
+                                     label       (.. node
+                                                     (append "text")
+                                                     (attr "dy" ".35em")
+                                                     (text #(gob/get % "title" "")))
+
+
+
+                                     ticked      (fn []
+                                                   (let [link-sel   (.. svg
+                                                                        (selectAll ".links > line"))
+                                                         circle-sel (.. svg
+                                                                        (selectAll ".node > circle"))
+                                                         label-sel  (.. svg
+                                                                        (selectAll ".node > text"))]
+                                                     (.. link-sel
+                                                         (attr "x1" (fn [d] (.. d -source -x)))
+                                                         (attr "y1" (fn [d] (.. d -source -y)))
+                                                         (attr "x2" (fn [d] (.. d -target -x)))
+                                                         (attr "y2" (fn [d] (.. d -target -y))))
+                                                     (.. circle-sel
+                                                         (attr "cx" (fn [d] (min-max (.. d -r) (.. d -x) (- width (.. d -r)))))
+                                                         (attr "cy" (fn [d] (min-max (.. d -r) (.. d -y) (- height (.. d -r))))))
+                                                     (.. label-sel
+                                                         (attr "x" #(+ (.-x %) 2 (.-r %)))
+                                                         (attr "y" #(+ (.-y %)))))
+                                                   nil)
+                                     ]
+                                 (.. simulation
+                                     (nodes nodes)
+                                     (on "tick" ticked))
+
+                                 (.. simulation
+                                     (force "link")
+                                     (links links))
+                                 ))
+           :d3-enter         (fn [ratom]
+
+                               (let [graph       (trace->sub-graph @ratom)
+                                     nodes       (clj->js (:nodes graph))
+                                     links       (clj->js (:links graph))
+
+                                     svg         @svg-a
+                                     color       @color-a
+                                     simulation  @simulation-a
+                                     _           (js/console.log "d3ent" (.. svg
+                                                                             (selectAll ".links > line")
+                                                                             size))
+
+                                     dragstarted (fn [d]
+                                                   (when (zero? (.. js/d3 -event -active))
+                                                     (.. simulation
+                                                         (alphaTarget 0.3)
+                                                         (restart)))
+
+                                                   (set! (.-fx d) (.-x d))
+                                                   (set! (.-fy d) (.-y d)))
+
+                                     dragged     (fn [d]
+                                                   (set! (.-fx d) (.. js/d3 -event -x))
+                                                   (set! (.-fy d) (.. js/d3 -event -y)))
+
+                                     dragended   (fn [d]
+                                                   (when (zero? (.. js/d3 -event -active))
+                                                     (.. simulation
+                                                         (alphaTarget 0.0)))
+                                                   (set! (.-fx d) nil)
+                                                   (set! (.-fy d) nil))
+
+                                     link        (.. (. svg append "g")
+                                                     (attr "class" "links")
+                                                     (selectAll "line")
+                                                     (data links)
+                                                     (enter)
+                                                     (append "line")
+                                                     (attr "stroke-width" (fn [d] (Math/sqrt (.-value d)))))
+
+                                     node        (.. (. svg append "g")
+                                                     (attr "class" "nodes")
+                                                     (selectAll "circle")
+                                                     (data nodes)
+                                                     (enter)
+                                                     (append "g")
+                                                     (attr "class" "node"))
+
+                                     circle      (.. node
+                                                     (append "circle")
+                                                     (attr "r" #(or (gob/get % "r" 10)))
+                                                     (attr "fill" (fn [d] (color (.-group d))))
+                                                     (call (.. (. js/d3 drag)
+                                                               (on "start" dragstarted)
+                                                               (on "drag" dragged)
+                                                               (on "end" dragended))))
+
+
+                                     label       (.. node
+                                                     (append "text")
+                                                     (attr "dy" ".35em")
+                                                     (text #(gob/get % "title" "")))
+
+                                     ]
+
+                                 (.. simulation
+                                     (force "link")
+                                     (links links))
+                                 (println "D3 did enter")
+                                 (js/console.log "d3 ent done" (.. svg
+                                                                   (selectAll ".links > line")
+                                                                   size))))}
+          traces-ratom)]
        [:hr]])))


Simplify exception (context provided by io.aviso.trackerS

--- src/io/aviso/rook/swagger.clj
+++ src/io/aviso/rook/swagger.clj
@@ -92,7 +92,7 @@
     ;; TODO: arrays

     :else
-    (throw (ex-info (format "Unable to convert schema %s to Swagger." schema)
+    (throw (ex-info "Unable to convert schema to Swagger."
                     {:schema schema}))))

 (defn default-query-params-injector


Yet another destructuring case

Yet another destructuring case

--- src/lt/plugins/elm_light/elm_ast.cljs
+++ src/lt/plugins/elm_light/elm_ast.cljs
@@ -535,17 +535,35 @@
       (when (= "variable" (:type fst-destruct-variable))
         (let [adtParam (-> adtType :params first)
               adtCandidate (get-candidate-by-token (:value adtParam) module modules) ]
-          (if adtCandidate
-            [{:value (:value adtCandidate)
-              :candidate (:value fst-destruct-variable)
-              :location (:location adtCandidate)
-              :package (:package adtCandidate)
-              :file (:file adtCandidate)
-              :doc (:doc adtCandidate)
-              :module-name (:module-name adtCandidate)}]
-
-            [{:value (:value adtParam)
-              :candidate (:value fst-destruct-variable)}])))
+          (concat
+            (when adtCandidate
+              [{:value (:value adtCandidate)
+                :candidate (:value fst-destruct-variable)
+                :location (:location adtCandidate)
+                :package (:package adtCandidate)
+                :file (:file adtCandidate)
+                :doc (:doc adtCandidate)
+                :module-name (:module-name adtCandidate)}])
+
+            (when (= "typeRec" (:type adtParam))
+              (concat
+                [{:value (str (:value candidate) "." (:value adtType) ".<customrecord>")
+                 :candidate (:value fst-destruct-variable)
+                 :location (:location adtParam)
+                 :doc (print-rec adtParam)
+                 :package (:package candidate)
+                 :file (:file candidate)
+                 :module-name (:module-name candidate)}])
+              (map #(hash-map
+                      :value (str (:value candidate) "." (:value adtType) ".<customrecord>." (:name %))
+                      :candidate (str (:value fst-destruct-variable) "." (:name %))
+                      :location (:location %)
+                      :doc (:signatureRaw %)
+                      :package (:package candidate)
+                      :file (:file candidate)
+                      :module-name (:module-name candidate))
+                   (:fieldDefs adtParam))))))
+

       (when [(= "patternRec" (:type fst-destruct-variable))]
         (let [adtParam (-> adtType :params first)
@@ -571,29 +589,29 @@

                 (when (= "patternRec" (:type fst-destruct-variable))
                   (map (fn [field]
-                        (when (get-field-def (:value field))
-                          (let [{:keys [location doc signatureRaw]} (get-field-def (:value field)) ]
-                            {:value (str (:value adtCandidate) "." (:value field))
-                             :candidate (:value field)
-                             :package (:package adtCandidate)
-                             :file (:file adtCandidate)
-                             :doc signatureRaw
-                             :location location
-                             :module-name (:module-name adtCandidate)})))
-                      (-> fst-destruct-variable :patterns)))
+                         (when (get-field-def (:value field))
+                           (let [{:keys [location doc signatureRaw]} (get-field-def (:value field)) ]
+                             {:value (str (:value adtCandidate) "." (:value field))
+                              :candidate (:value field)
+                              :package (:package adtCandidate)
+                              :file (:file adtCandidate)
+                              :doc signatureRaw
+                              :location location
+                              :module-name (:module-name adtCandidate)})))
+                       (-> fst-destruct-variable :patterns)))

                 (when (= "patternBracket" (:type fst-destruct-variable))
                   (map (fn [field]
-                        (when (get-field-def (:value field))
-                          (let [{:keys [location doc signatureRaw]} (get-field-def (:value field)) ]
-                            {:value (str (:value adtCandidate) "." (:value field))
-                             :candidate (:value field)
-                             :package (:package adtCandidate)
-                             :file (:file adtCandidate)
-                             :doc signatureRaw
-                             :location location
-                             :module-name (:module-name adtCandidate)})))
-                      (-> fst-destruct-variable :pattern :value :patterns)))))
+                         (when (get-field-def (:value field))
+                           (let [{:keys [location doc signatureRaw]} (get-field-def (:value field)) ]
+                             {:value (str (:value adtCandidate) "." (:value field))
+                              :candidate (:value field)
+                              :package (:package adtCandidate)
+                              :file (:file adtCandidate)
+                              :doc signatureRaw
+                              :location location
+                              :module-name (:module-name adtCandidate)})))
+                       (-> fst-destruct-variable :pattern :value :patterns)))))

             (when (= "typeRec" (-> adtType :params first :type))
               (concat
@@ -805,6 +823,7 @@
     (if (and (= "nameDef" (:type decl))
              (-> decl :annotation :signature))
       (mapcat (fn [param {:keys [candidate] :as ann}]
+
                 (cond
                   (and (= "variable" (:type param))
                        (= "typeRec" (:type ann)))
@@ -878,11 +897,13 @@
                        (not (in-range? pos (-> decl :annotation))))

+
                   (let [pattern-param (-> param :pattern :value :variables first)
                         adtType (-> candidate :adtDefs first)
                         adtPattern (:pattern param)
                         adtParam (-> adtType :params first)
                         adtCandidate (get-jump-to-by-token (:value adtParam))]
+
                     (concat
                       (when-let [aliaz (:alias adtPattern)]
                         [{:candidate aliaz
@@ -891,6 +912,13 @@
                       (when (and (= "variable" (:type pattern-param))
                                  (nil? (:type adtCandidate)))
                         [{:candidate (:value pattern-param)}])
+
+                      (when (and (= "variable" (:type pattern-param))
+                                 (= "typeRec" (:type adtParam)))
+                        (map #(hash-map
+                                :candidate (str (:value pattern-param) "." (:name %))
+                                :module-name (mod-name candidate))
+                             (:fieldDefs adtParam)))

                       (when (and (= "variable" (:type pattern-param))
                                  (= "typeAliasDecl" (:type adtCandidate)))


CMR-1359: Adding logging during ingest of ingest details.

--- ingest-app/src/cmr/ingest/api/routes.clj
+++ ingest-app/src/cmr/ingest/api/routes.clj
@@ -57,6 +57,11 @@
          :concept-type concept-type}
         (set-concept-id-and-revision-id headers))))

+(defn- concept->loggable-string
+  "Returns a string with information about the concept as a loggable string."
+  [concept]
+  (pr-str (dissoc concept :metadata)))
+
 (defmulti validate-granule
   "Validates the granule in the request. It can handle a granule and collection sent as multipart-params
   or a normal request with the XML as the body."
@@ -67,9 +72,9 @@

 (defmethod validate-granule :default
   [provider-id native-id {:keys [body content-type headers request-context] :as request}]
-  (ingest/validate-granule
-    request-context
-    (body->concept :granule provider-id native-id body content-type headers)))
+  (let [concept (body->concept :granule provider-id native-id body content-type headers)]
+    (info "Validating granule" (concept->loggable-string concept))
+    (ingest/validate-granule request-context concept)))

 (defn- multipart-param->concept
   "Converts a multipart parameter "
@@ -97,6 +102,8 @@
                        provider-id native-id :collection (get multipart-params "collection"))
         gran-concept (multipart-param->concept
                        provider-id native-id :granule (get multipart-params "granule"))]
+    (info "Validating granule" (concept->loggable-string gran-concept) "with collection"
+          (concept->loggable-string coll-concept))
     (ingest/validate-granule-with-parent-collection request-context gran-concept coll-concept)))

 (defn- build-routes [system]
@@ -106,20 +113,19 @@
       (context "/providers/:provider-id" [provider-id]
         (context ["/validate/collection/:native-id" :native-id #".*$"] [native-id]
           (POST "/" {:keys [body content-type headers request-context]}
-            (ingest/validate-concept
-              request-context
-              (body->concept :collection provider-id native-id body content-type headers))
-            {:status 200}))
+            (let [concept (body->concept :collection provider-id native-id body content-type headers)]
+              (info "Validating Collection" (concept->loggable-string concept))
+              (ingest/validate-concept request-context concept)
+              {:status 200})))

         (context ["/collections/:native-id" :native-id #".*$"] [native-id]
           (PUT "/" {:keys [body content-type headers request-context params]}
             (let [context (acl/add-authentication-to-context request-context params headers)]
               (acl/verify-ingest-management-permission
                 context :update :provider-object provider-id)
-              (r/response
-                (ingest/save-concept
-                  request-context
-                  (body->concept :collection provider-id native-id body content-type headers)))))
+              (let [concept (body->concept :collection provider-id native-id body content-type headers)]
+                (info "Ingesting collection" (concept->loggable-string concept))
+                (r/response (ingest/save-concept request-context concept)))))
           (DELETE "/" {:keys [request-context params headers]}
             (let [concept-attribs {:provider-id provider-id
                                    :native-id native-id
@@ -127,7 +133,7 @@
                   context (acl/add-authentication-to-context request-context params headers)]
               (acl/verify-ingest-management-permission
                 context :update :provider-object provider-id)
-
+              (info "Deleting collection" (pr-str concept-attribs))
               (r/response (ingest/delete-concept request-context concept-attribs)))))

         (context ["/validate/granule/:native-id" :native-id #".*$"] [native-id]
@@ -140,10 +146,9 @@
             (let [context (acl/add-authentication-to-context request-context params headers)]
               (acl/verify-ingest-management-permission
                 context :update :provider-object provider-id)
-              (r/response
-                (ingest/save-concept
-                  request-context
-                  (body->concept :granule provider-id native-id body content-type headers)))))
+              (let [concept (body->concept :granule provider-id native-id body content-type headers)]
+                (info "Ingesting granule" (concept->loggable-string concept))
+                (r/response (ingest/save-concept request-context concept)))))
           (DELETE "/" {:keys [request-context params headers]}
             (let [concept-attribs {:provider-id provider-id
                                    :native-id native-id
@@ -151,6 +156,7 @@
                   context (acl/add-authentication-to-context request-context params headers)]
               (acl/verify-ingest-management-permission
                 context :update :provider-object provider-id)
+              (info "Deleting granule" (pr-str concept-attribs))
               (r/response (ingest/delete-concept request-context concept-attribs))))))

       ;; add routes for managing jobs


upload returns the entire worker data

upload returns the entire worker data

--- src/hivewing_core/worker_config.clj
+++ src/hivewing_core/worker_config.clj
@@ -28,13 +28,15 @@

 (defn worker-config-set
   "Set the configuration on the worker. Provided a uuid and the paramters as a hash.
-  The keys for the parameters should be strings or keywords"
+  The keys for the parameters should be strings or keywords.
+  Returns the current full worker-config state"
   [worker-uuid parameters]
   ; Want to split the parameters
   (doseq [kv-pair parameters]
-    (let [upload-data {:uuid worker-uuid,
-               "key"  (name (get kv-pair 0)),
-               "data" (str (get kv-pair 1)),
-               "_uat" (System/currentTimeMillis),
+    (let [upload-data {"uuid" worker-uuid,
+                       "key"  (name (get kv-pair 0)),
+                       "data" (str (get kv-pair 1)),
+                       "_uat" (System/currentTimeMillis),
                }]
-      (put-item aws-credentials ddb-worker-table upload-data))))
+      (put-item aws-credentials ddb-worker-table upload-data)))
+  (worker-config-get worker-uuid))