Add a text output option to the custom formats

Fixes #28

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -9,7 +9,8 @@
              [common :refer [translations]]
              [dtbook :as layout.dtbook]
              [fop :as layout.fop]
-             [obi :as layout.obi]]
+             [obi :as layout.obi]
+             [text :as layout.text]]
             [catalog.web.layout :as layout]
             [cemerick.friend :as friend]
             [clj-time
@@ -123,23 +124,32 @@
   [resp filename]
   (response/header resp "Content-Disposition" (format "attachment; filename=%s" filename)))

+(defn- download-response
+  "Create a response with proper content-type and content-disposition
+  for given `file`, `mime-type` and `filename`"
+  [file mime-type filename]
+  (-> file
+   response/response
+   (response/content-type mime-type)
+   (content-disposition filename)))
+
 (defn- pdf-response
   "Create a response with proper content-type and content-disposition
   for given pdf `file` and `filename`"
   [file filename]
-  (-> file
-   response/response
-   (response/content-type "application/pdf")
-   (content-disposition (str filename ".pdf"))))
+  (download-response file "application/pdf" (str filename ".pdf")))

 (defn- xml-response
   "Create a response with proper content-type and content-disposition
   for given `body` and `filename`"
   [body filename]
-  (-> body
-   response/response
-   (response/content-type "application/xml")
-   (content-disposition (str filename ".xml"))))
+  (download-response body "application/xml" (str filename ".xml")))
+
+(defn- text-response
+  "Create a response with proper content-type and content-disposition
+  for given `body` and `filename`"
+  [body filename]
+  (download-response body "text/plain" (str filename ".txt")))

 (defn neu-im-sortiment [year issue]
   (let [filename (file-name :catalog-all year issue)
@@ -380,7 +390,8 @@
     {:class "form-control"} "fmt"
     [["PDF" :pdf]
      ["Grossdruck" :grossdruck]
-     ["Braille" :braille]]
+     ["Braille" :braille]
+     ["Text" :plain-text]]
     selected)])

 (defn custom-form [request year issue & [errors]]
@@ -463,5 +474,11 @@
       edn/read-string
       vubis/order
       (layout.dtbook/dtbook {:query query :customer customer})
-      (xml-response (str (file-name :catalog-custom customer) ".xml"))))
-
+      (xml-response (file-name :catalog-custom customer))))
+
+(defmethod custom :plain-text [request year issue query customer fmt items]
+  (-> items
+      edn/read-string
+      vubis/order
+      (layout.text/text {:query query :customer customer})
+      (text-response (file-name :catalog-custom customer))))


Dynamically find module.edn files from top-level modules

--- src/braid/core/module_helpers.clj
+++ src/braid/core/module_helpers.clj
@@ -1,12 +1,13 @@
 (ns braid.core.module-helpers
   (:require
-   [clojure.tools.reader.edn :as edn]))
+   [clojure.tools.reader.edn :as edn]
+   [clojure.java.io :as io]))

 (def module-files
-  ;; TODO: glob, have a search path, have a registery or something
-  ["src/braid/core/module.edn"
-   "src/braid/quests/module.edn"
-   "src/braid/emoji/module.edn"])
+  (for [dir (.listFiles (io/file "src/braid/"))
+        :let [m (io/file dir "module.edn")]
+        :when (.isFile m)]
+    m))

 (defn read-module
   [module-path]


Ensure no default session options are applied to any wrapped routes

--- src/braid/core/server/handler.clj
+++ src/braid/core/server/handler.clj
@@ -19,7 +19,8 @@
       (assoc-in [:security :anti-forgery] true)))

 (def static-site-defaults
-  {:params {:urlencoded true
+  {:session false
+   :params {:urlencoded true
             :multipart  true
             :nested     true
             :keywordize true}
@@ -44,24 +45,32 @@

        (-> api-public-routes
            (wrap-defaults (-> site-defaults
+                              (assoc :session false)
                               (assoc-in [:security :anti-forgery] false))))

        (-> modules/public-handler
            (wrap-defaults (-> site-defaults
+                              (assoc :session false)
                               (assoc-in [:security :anti-forgery] false)))
            (wrap-restful-format :formats [:edn :transit-json]))

        (-> sync-routes
-           (wrap-defaults (-> api-defaults assoc-csrf-conf)))
+           (wrap-defaults (-> api-defaults
+                              (assoc :session false)
+                              assoc-csrf-conf)))

        (-> api-private-routes
-           (wrap-defaults (-> api-defaults assoc-csrf-conf)))
+           (wrap-defaults (-> api-defaults
+                              (assoc :session false)
+                              assoc-csrf-conf)))

        ;; this needs to be last, because the middleware will return
        ;; 401 if not authorized & hence not fall-through to other
        ;; routes
        (-> modules/private-handler
-           (wrap-defaults (-> site-defaults assoc-csrf-conf))
+           (wrap-defaults (-> site-defaults
+                              (assoc :session false)
+                              assoc-csrf-conf))
            (wrap-restful-format :formats [:edn :transit-json])))
       (wrap-cors :access-control-allow-origin (->>
                                                [(when-let [site (env :site-url)]


remove debug output

remove debug output

--- src/brainbot/nozzle/esconnect.clj
+++ src/brainbot/nozzle/esconnect.clj
@@ -180,8 +180,6 @@
         id (make-id "" directory (:relpath entry))
         simple-perms (simplify-permissions-for-es (:permissions entry))]

-    (println "simple-import-file" fs id entry)
-    (println "permissions" simple-perms)

     (esd/put es-index "doc"
              id


specs

specs

--- src/cljs/algorithms_clj/binary_tree_specs.clj
+++ src/cljs/algorithms_clj/binary_tree_specs.clj
@@ -17,5 +17,6 @@
 (defmacro binary-tree-of
   [pred]
   `(s/and
+     #(s/valid? ::binary-tree-impl %)
      #(every? (partial s/valid? ~pred) (dfs-binary-tree %))
-     ::binary-tree-impl))+     ))


sorted habits

sorted habits

--- src/cljs/iwaswhere_web/ui/entry/briefing.cljs
+++ src/cljs/iwaswhere_web/ui/entry/briefing.cljs
@@ -52,14 +52,17 @@
         results (subscribe [:results])
         options (subscribe [:options])
         entries-map (subscribe [:entries-map])
-        waiting-habits (reaction
-                         (let [entries-map @entries-map
-                               entries (map (fn [ts] (get entries-map ts))
-                                            (:waiting-habits @results))
-                               conf (merge @cfg @options)]
-                           (if (:show-pvt @cfg)
-                             entries
-                             (filter (u/pvt-filter conf entries-map) entries))))]
+
+        waiting-habits
+        (reaction
+          (let [entries-map @entries-map
+                entries (->> (:waiting-habits @results)
+                             (map (fn [ts] (get entries-map ts)))
+                             (sort-by #(or (-> % :habit :priority) :X)))
+                conf (merge @cfg @options)]
+            (if (:show-pvt @cfg)
+              entries
+              (filter (u/pvt-filter conf entries-map) entries))))]
     (fn waiting-habits-list-render [tab-group put-fn]
       (let [waiting-habits @waiting-habits]
         (when (seq waiting-habits)
@@ -108,7 +111,7 @@
             filter-fn (u/linked-filter-fn @entries-map current-filter put-fn)
             linked-entries (->> linked-entries
                                 (filter filter-fn)
-                                (sort-by #(-> % :task :priority)))]
+                                (sort-by #(or (-> % :task :priority) :X)))]
         [:div.linked-tasks
          [:div
           [:strong "Tasks:"]


Use reify instead defrecord for http basic backend.

--- src/clojure/buddy/auth/backends/httpbasic.clj
+++ src/clojure/buddy/auth/backends/httpbasic.clj
@@ -32,29 +32,27 @@
     (let [[username, password] (split decoded #":")]
       {:username username :password password})))

-(defrecord HttpBasicBackend [realm authfn unauthorized-handler]
-  proto/Authentication
-  (parse [_ request]
-    (parse-httpbasic-header request))
-  (authenticate [_ request data]
-    (let [rsq (when authfn (authfn request data))]
-      (if (response? rsq) rsq
-        (assoc request :identity rsq))))
-
-  proto/Authorization
-  (handle-unauthorized [_ request metadata]
-    (if unauthorized-handler
-      (unauthorized-handler request (assoc metadata :realm realm))
-      (do
-        (if (authenticated? request)
-          (-> (response "Permission denied")
-              (status 403))
-          (-> (response "Unauthorized")
-              (header "WWW-Authenticate" (format "Basic realm=\"%s\"" realm))
-              (status 401)))))))
-
 (defn http-basic-backend
   "Given some options, create a new instance
   of HttpBasicBackend and return it."
   [& [{:keys [realm authfn unauthorized-handler] :or {realm "Buddy Auth"}}]]
-  (->HttpBasicBackend realm authfn unauthorized-handler))
+  (reify
+    proto/Authentication
+    (parse [_ request]
+      (parse-httpbasic-header request))
+    (authenticate [_ request data]
+      (let [rsq (when authfn (authfn request data))]
+        (if (response? rsq) rsq
+            (assoc request :identity rsq))))
+
+    proto/Authorization
+    (handle-unauthorized [_ request metadata]
+      (if unauthorized-handler
+        (unauthorized-handler request (assoc metadata :realm realm))
+        (do
+          (if (authenticated? request)
+            (-> (response "Permission denied")
+                (status 403))
+            (-> (response "Unauthorized")
+                (header "WWW-Authenticate" (format "Basic realm=\"%s\"" realm))
+                (status 401))))))))


add non-init reduce case to traverse

add non-init reduce case to traverse

--- src/clj/com/rpl/specter/impl.cljx
+++ src/clj/com/rpl/specter/impl.cljx
@@ -653,7 +653,9 @@
     ))

 (defn do-compiled-traverse [apath structure]
-  (reify clojure.lang.IReduceInit
+  (reify clojure.lang.IReduce
+    (reduce [this afn]
+      (.reduce this afn (afn)))
     (reduce [this afn start]
       (let [cell (mutable-cell start)]
         (compiled-traverse*


Chronos Protocol interaction with Titanium Ribs

--- src/clj/game/cards-identities.clj
+++ src/clj/game/cards-identities.clj
@@ -86,26 +86,31 @@
    {:events
     {:pre-resolve-damage
      {:once :per-turn
-      :req (req (and (= target :net) (> (last targets) 0)))
-      :effect (effect (damage-defer :net (last targets))
-                      (show-wait-prompt :runner "Corp to use Chronos Protocol: Selective Mind-mapping")
-                      (resolve-ability
-                        {:optional {:prompt (str "Use Chronos Protocol: Selective Mind-mapping to reveal the Runner's "
-                                                 "grip to select the first card trashed?") :player :corp
-                                    :yes-ability {:prompt (msg "Choose a card to trash")
-                                                  :choices (req (:hand runner)) :not-distinct true
-                                                  :msg (msg "trash " (:title target)
-                                                         (when (> (- (get-defer-damage state side :net nil) 1) 0)
-                                                           (str " and deal "
-                                                                (- (get-defer-damage state side :net nil) 1)
-                                                                " more net damage")))
-                                                  :effect (effect (clear-wait-prompt :runner)
-                                                                  (trash target {:cause :net :unpreventable true})
-                                                                  (damage :net (- (get-defer-damage state side :net nil) 1)
-                                                                          {:unpreventable true :card card}))}
-                                    :no-ability {:effect (effect (clear-wait-prompt :runner)
-                                                                 (damage :net (get-defer-damage state side :net nil)
-                                                                         {:unpreventable true :card card}))}}} card nil))}}}
+      :req (req (and (= target :net)
+                     (not (and (= (:active-player @state) :runner) (get-in @state [:damage] :damage-choose)))
+                     (> (last targets) 0)))
+      :effect (req (swap! state assoc-in [:damage :damage-choose] true)
+                   (damage-defer state side :net (last targets))
+                   (show-wait-prompt state :runner "Corp to use Chronos Protocol: Selective Mind-mapping")
+                   (resolve-ability state side
+                     {:optional {:prompt (str "Use Chronos Protocol: Selective Mind-mapping to reveal the Runner's "
+                                              "Grip to select the first card trashed?") :player :corp
+                                 :yes-ability {:prompt (msg "Choose a card to trash")
+                                               :choices (req (:hand runner)) :not-distinct true
+                                               :msg (msg "trash " (:title target)
+                                                      (when (> (- (get-defer-damage state side :net nil) 1) 0)
+                                                        (str " and deal "
+                                                             (- (get-defer-damage state side :net nil) 1)
+                                                             " more net damage")))
+                                               :effect (req (swap! state update-in [:damage] dissoc :damage-choose)
+                                                            (clear-wait-prompt state :runner)
+                                                            (trash state side target {:cause :net :unpreventable true})
+                                                            (damage state side :net (- (get-defer-damage state side :net nil) 1)
+                                                                    {:unpreventable true :card card}))}
+                                 :no-ability {:effect (req (swap! state update-in [:damage] dissoc :damage-choose)
+                                                           (clear-wait-prompt state :runner)
+                                                           (damage state side :net (get-defer-damage state side :net nil)
+                                                                   {:unpreventable true :card card}))}}} card nil))}}}

    "Cybernetics Division: Humanity Upgraded"
    {:effect (effect (lose :hand-size-modification 1)


Update cryptojs includes

Update cryptojs includes

--- src/clj/whatishistory/handler.clj
+++ src/clj/whatishistory/handler.clj
@@ -30,7 +30,8 @@
      (include-js "//l2.io/ip.js?var=myip")
      (include-js "//www.parsecdn.com/js/parse-1.6.7.min.js")
      (include-js "js/parse.js")
-     (include-js "//crypto-js.googlecode.com/svn/tags/3.1.2/build/rollups/sha1.js")
+     (include-js "//cdnjs.cloudflare.com/ajax/libs/crypto-js/3.1.2/components/core-min.js")
+     (include-js "///cdnjs.cloudflare.com/ajax/libs/crypto-js/3.1.2/components/sha1-min.js")
      (include-js "js/app.js")
      (include-js "js/countries.js")]]))


add calendar icon

add calendar icon


Initialize parinfer later

Initialize parinfer later

--- src/clojure/nightcode/editors.clj
+++ src/clojure/nightcode/editors.clj
@@ -569,9 +569,6 @@
       ; add watchers
       (add-watchers! path extension text-area completer)
       (add-button-watchers! path editor-pane)
-      ; initialize parinfer
-      (init-parinfer! text-area extension edit-history true)
-      (update-buttons! editor-pane text-area)
       ; enable/disable buttons while typing
       (.addDocumentListener (.getDocument text-area)
         (reify DocumentListener
@@ -581,6 +578,9 @@
             (update-buttons! editor-pane text-area))
           (removeUpdate [this e]
             (update-buttons! editor-pane text-area))))
+      ; initialize parinfer
+      (init-parinfer! text-area extension edit-history true)
+      (update-buttons! editor-pane text-area)
       ; return a map describing the editor
       {:view editor-pane
        :text-area text-area


Added test that we can spatially search for collections in dif format and granules in collections with dif format.

--- test/cmr/system_int_test/search/collection_search_format_test.clj
+++ test/cmr/system_int_test/search/collection_search_format_test.clj
@@ -5,10 +5,13 @@
             [cmr.system-int-test.utils.search-util :as search]
             [cmr.system-int-test.utils.index-util :as index]
             [cmr.system-int-test.data2.collection :as dc]
+            [cmr.system-int-test.data2.granule :as dg]
             [cmr.system-int-test.data2.core :as d]
             [cmr.system-int-test.utils.url-helper :as url]
             [clj-http.client :as client]
-            [cmr.umm.core :as umm]))
+            [cmr.umm.core :as umm]
+            [cmr.spatial.mbr :as m]
+            [cmr.spatial.codec :as codec]))

 (use-fixtures :each (ingest/reset-fixture "PROV1" "PROV2"))

@@ -72,4 +75,52 @@
                                       :connection-manager (url/conn-mgr)})]
             (is (= (umm/umm->xml c1-echo :echo10) (:body response)))))))))

+;; Tests that we can ingest and find difs with spatial and that granules in the dif can also be
+;; ingested and found
+(deftest dif-with-spatial
+  (let [c1 (d/ingest "PROV1" (dc/collection {:spatial-coverage nil}) :dif)
+        g1 (d/ingest "PROV1" (dg/granule c1))

+        ;; A collection with a granule spatial representation
+        c2 (d/ingest "PROV1" (dc/collection {:spatial-coverage (dc/spatial :geodetic)}) :dif)
+        g2 (d/ingest "PROV1" (dg/granule c2 {:spatial-coverage (dg/spatial (m/mbr -160 45 -150 35))}))
+
+
+        ;; A collections with a granule spatial representation and spatial data
+        c3 (d/ingest "PROV1"
+                     (dc/collection
+                       {:spatial-coverage
+                        (dc/spatial :geodetic
+                                    :geodetic
+                                    (m/mbr -10 9 0 -10))})
+                     :dif)
+        g3 (d/ingest "PROV1" (dg/granule c3))]
+    (index/refresh-elastic-index)
+
+    (testing "spatial search for dif collections"
+      (are [wnes items]
+           (let [found (search/find-refs :collection {:bounding-box (codec/url-encode (apply m/mbr wnes))})
+                 matches? (d/refs-match? items found)]
+             (when-not matches?
+               (println "Expected:" (pr-str (map :entry-title items)))
+               (println "Actual:" (->> found :refs (map :name) pr-str)))
+             matches?)
+           ;; whole world
+           [-180 90 180 -90] [c3]
+           [-180 90 -11 -90] []
+           [-20 20 20 -20] [c3]))
+
+    (testing "spatial search for granules in dif collections"
+      (are [wnes items]
+           (let [found (search/find-refs :granule {:bounding-box (codec/url-encode (apply m/mbr wnes))})
+                 matches? (d/refs-match? items found)]
+             (when-not matches?
+               (println "Expected:" (pr-str (map :entry-title items)))
+               (println "Actual:" (->> found :refs (map :name) pr-str)))
+             matches?)
+           ;; whole world
+           [-180 90 180 -90] [g2]
+           [0 90 180 -90] []
+           [-180 90 0 -90] [g2]))))
+
+


put analysis caching behind `:cache-analysis` compiler flag, add `last-modified` helper that can handle Files & URLs. Improve `requires-analysis?` by using new helpers & providing parameter defaults to simplify testing.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -19,6 +19,7 @@
             [clojure.tools.reader.reader-types :as readers])
   (:import java.lang.StringBuilder
            java.io.File
+           java.net.URL
            [cljs.tagged_literals JSValue]))

 (set! *warn-on-reflection* true)
@@ -1687,16 +1688,36 @@
         (swap! env/*compiler* assoc ::namespaces namespaces')
         ret))))

-(defn requires-analysis? [^File f ^File cache]
-  (or (not (.exists cache))
-      (> (.lastModified f) (.lastModified cache))
-      (let [version' (util/compiled-by-version cache)
-            version  (util/clojurescript-version)]
-        (and version (not= version version')))))
-
-(defn cache-file [f output-dir]
-  (let [ns-info (parse-ns f)]
-    (io/file (util/to-target-file output-dir ns-info) ".cache.edn")))
+(defn cache-file
+  ([src] (cache-file src "out"))
+  ([src output-dir]
+    (let [ns-info (parse-ns src)]
+      (io/file (str (util/to-target-file output-dir ns-info) ".cache.edn")))))
+
+(defn last-modified [src]
+  (cond
+    (instance? File src) (.lastModified ^File src)
+    (instance? URL src) (.getLastModified (.openConnection ^URL src))
+    :else
+    (throw
+      (IllegalArgumentException. (str "Cannot get last modified for " src)))))
+
+(defn requires-analysis?
+  ([src] (requires-analysis? src "out"))
+  ([src output-dir]
+    (let [cache (cache-file src output-dir)]
+      (requires-analysis? src cache output-dir)))
+  ([src ^File cache output-dir]
+    (if (not (.exists cache))
+      true
+      (let [out-src (util/to-target-file output-dir (parse-ns src))]
+        (if (not (.exists out-src))
+          true
+          (or
+            (> (last-modified src) (last-modified cache))
+            (let [version' (util/compiled-by-version cache)
+                  version (util/clojurescript-version)]
+              (and version (not= version version')))))))))

 (defn analyze-file
   ([f] (analyze-file f nil))
@@ -1711,9 +1732,8 @@
          (let [path (if (instance? File res)
                       (.getPath ^File res)
                       (.getPath ^java.net.URL res))
-               ;; cache (if output-dir
-               ;;         (cache-file res output-dir))
-               ]
+               cache (when (and (:cache-analysis opts) output-dir)
+                       (cache-file res output-dir))]
            (when-not (get-in @env/*compiler* [::analyzed-cljs path])
              (binding [*cljs-ns* 'cljs.user
                        *cljs-file* path
@@ -1728,5 +1748,9 @@
                                  (recur (:name ast) (next forms))
                                  (recur ns (next forms))))
                              ns))]
+                 (when cache
+                   (spit cache
+                     (str ";; Analyzed by ClojureScript " (util/clojurescript-version) "\n"
+                       (pr-str (get-in @env/*compiler* [::namespaces ns])))))
                  (swap! env/*compiler* assoc-in [::analyzed-cljs path] true)))))))))


add cljs.analyzer/requires-analysis?

add cljs.analyzer/requires-analysis?

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -8,7 +8,8 @@

 (ns cljs.analyzer
   (:refer-clojure :exclude [macroexpand-1])
-  (:require [clojure.java.io :as io]
+  (:require [cljs.util :as util]
+            [clojure.java.io :as io]
             [clojure.string :as string]
             [clojure.set :as set]
             [cljs.env :as env]
@@ -1615,6 +1616,13 @@
                   (cons form (forms-seq*))))))]
        (forms-seq*))))

+(defn requires-analysis? [^File f ^File cache]
+  (or (not (.exists cache))
+      (> (.lastModified f) (.lastModified cache))
+      (let [version' (util/compiled-by-version cache)
+            version  (util/clojurescript-version)]
+        (and version (not= version version')))))
+
 (defn analyze-file
   ([f] (analyze-file f nil))
   ([f opts]


* src/clj/cljs/compiler.clj: remove unnecessary .call usage

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -485,12 +485,12 @@
         (emits arglist)
         (dotimes [_ (- (count params) 2)] (emits ")"))
         (emitln ");")
-        (emitln "return " delegate-name ".call(" (string/join ", " (cons "this" params)) ");"))
+        (emitln "return " delegate-name "(" (string/join ", " params) ");"))
       (do
         (emits "var " (last params) " = ")
         (emits "cljs.core.seq(" arglist ");")
         (emitln ";")
-        (emitln "return " delegate-name ".call(" (string/join ", " (cons "this" params)) ");")))
+        (emitln "return " delegate-name "(" (string/join ", " params) ");")))
     (emits "})")))

 (defn emit-fn-method
@@ -587,7 +587,7 @@
           (doseq [[n meth] ms]
             (if (:variadic meth)
               (do (emitln "default:")
-                  (emitln "return " n ".cljs$lang$arity$variadic.call(this,"
+                  (emitln "return " n ".cljs$lang$arity$variadic("
                           (comma-sep (butlast maxparams))
                           (and (> (count maxparams) 1) ", ")
                           "cljs.core.array_seq(arguments, " max-fixed-arity "));"))


added fields description

added fields description

--- src/clj/datasplash/bq.clj
+++ src/clj/datasplash/bq.clj
@@ -130,11 +130,12 @@

 (defn- clj->TableFieldSchema
   [defs transform-keys]
-  (for [{:keys [type mode] field-name :name nested-fields :fields} defs]
+  (for [{:keys [type mode description] field-name :name nested-fields :fields} defs]
        (-> (TableFieldSchema.)
            (.setName (transform-keys (clean-name field-name)))
            (.setType  (str/upper-case (name type)))
            (cond-> mode (.setMode mode))
+           (cond-> description (.setDescription description))
            (cond-> nested-fields (.setFields (clj->TableFieldSchema nested-fields transform-keys))))))

 (defn ^TableSchema ->schema


only add the timber helmsman assets if running as standalone

--- src/clj/traveler/core.clj
+++ src/clj/traveler/core.clj
@@ -40,8 +40,6 @@
 (def helmsman-definition
   "Main helmsman definition"
   [[:resources "/"]
-   (first timber/helmsman-assets)
-   (second timber/helmsman-assets)
    ^{:name "Traveler"
      :main-menu true}
    [:any "/" dash-redirect
@@ -58,9 +56,12 @@
    [wrap-params]
    ])

+(def standalone-helmsman-definition
+  (into helmsman-definition (vector (first timber/helmsman-assets) (second timber/helmsman-assets))))
+
 (def app
   "Main app"
-  (compile-routes helmsman-definition))
+  (compile-routes standalone-helmsman-definition))

 (defn init
   "Immutant dev init function"


fixes issues #334

fixes issues #334

--- src/clj_http/conn_mgr.clj
+++ src/clj_http/conn_mgr.clj
@@ -53,7 +53,7 @@
   (proxy [SSLConnectionSocketFactory] [(SSLContexts/createDefault)]
     (connectSocket [timeout socket host remoteAddress localAddress context]
       (let [^SSLConnectionSocketFactory this this] ;; avoid reflection
-        (proxy-super connectSocket timeout (socket-factory) remoteAddress
+        (proxy-super connectSocket timeout (socket-factory) host remoteAddress
                      localAddress context)))))

 (defn ^PlainConnectionSocketFactory PlainGenericSocketFactory


* src/cljs/cljs/reader.cljs: CLJS-117: fix read-symbol bug

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -250,7 +250,7 @@
   (let [token (read-token reader initch)]
     (if (gstring/contains token "/")
       (symbol (subs token 0 (.indexOf token "/"))
-              (subs (inc (.indexOf token "/")) (.length token)))
+              (subs token (inc (.indexOf token "/")) (.length token)))
       (get special-symbols token (symbol token)))))

 (defn read-keyword


Added join, upper/lower-case, capitalize, and escape to cljs.string.

--- src/cljs/cljs/string.cljs
+++ src/cljs/cljs/string.cljs
@@ -1,5 +1,5 @@
 (ns cljs.string
-  ;; TODO get refer-clojure exclude working
+  ;; TODO pending refer-clojure exclude support
   #_(:refer-clojure :exclude [replace reverse])
   (:require [goog.string :as gstring]
             [goog.string.StringBuffer :as gstringbuf]))
@@ -17,13 +17,15 @@
       (when coll
         (.append sb (first coll))
         (recur (next coll))))
-    (str sb)))
+    (. sb (toString))))

-(defn- replace-by
-  [s re f])
+;; TODO all replace* functions pending regexp support
+#_(defn- replace-by
+    [s re f]
+    )

-(defn replace
-  "Replaces all instance of match with replacement in s.
+#_(defn replace
+    "Replaces all instance of match with replacement in s.

    match/replacement can be:

@@ -32,16 +34,16 @@
    pattern / (string or function of match).

    See also replace-first."
-  [s match replacement])
+    [s match replacement])

-(defn- replace-first-by
-  [s re f])
+#_(defn- replace-first-by
+    [s re f])

-(defn- replace-first-char
-  [s match replace])
+#_(defn- replace-first-char
+    [s match replace])

-(defn replace-first
-  "Replaces the first instance of match with replacement in s.
+#_(defn replace-first
+    "Replaces the first instance of match with replacement in s.

    match/replacement can be:

@@ -50,64 +52,106 @@
    pattern / (string or function of match).

    See also replace-all."
-  [s match replacement])
+    [s match replacement])

-(comment
+(defn join
+  "Returns a string of all elements in coll, as returned by (seq coll),
+   separated by an optional separator."
+  ([coll]
+     (apply str coll))
+  ([separator coll]
+     (apply str (interpose separator coll))))

-  (defn join
-    "Returns a string of all elements in coll, as returned by (seq coll),
-   separated by an optional separator."
-    ([coll])
-    ([separator coll]))
+(defn upper-case
+  "Converts string to all upper-case."
+  [s]
+  (. s (toUpperCase)))

-  (defn capitalize
-    "Converts first character of the string to upper-case, all other
+(defn lower-case
+  "Converts string to all lower-case."
+  [s]
+  (. s (toLowerCase)))
+
+(defn capitalize
+  "Converts first character of the string to upper-case, all other
   characters to lower-case."
-    [s])
+  [s]
+  (if (< (count s) 2)
+    (upper-case s)
+    (str (upper-case (subs s 0 1))
+         (lower-case (subs s 1)))))

-  (defn upper-case
-    "Converts string to all upper-case."
-    [s])
-
-  (defn lower-case
-    "Converts string to all lower-case."
-    [s])
-
-  (defn split
+;; TODO pending regexp support
+#_(defn split
     "Splits string on a regular expression.  Optional argument limit is
   the maximum number of splits. Not lazy. Returns vector of the splits."
     ([s re])
     ([s re limit]))

-  (defn split-lines
-    "Splits s on \\n or \\r\\n."
+#_(defn split-lines
+  "Splits s on \\n or \\r\\n."
+  [s])
+
+;; TODO all whitespace related functions pending regexp support
+#_(def whitespace)
+
+#_(defn triml
+    "Removes whitespace from the left side of string."
     [s])

-  (defn trim
+#_(defn trimr
+    "Removes whitespace from the right side of string."
+    [s])
+
+#_(defn trim
     "Removes whitespace from both ends of string."
     [s])

-  (defn triml
-    "Removes whitespace from the left side of string."
-    [s])
-
-  (defn trimr
-    "Removes whitespace from the right side of string."
-    [s])
-
-  (defn trim-newline
+#_(defn trim-newline
     "Removes all trailing newline \\n or return \\r characters from
   string.  Similar to Perl's chomp."
     [s])

-  (defn blank?
+#_(defn blank?
     "True if s is nil, empty, or contains only whitespace."
-    [s])
+    [s]
+    (if s
+      (loop [index (int 0)]
+        (if (= (.length s))
+          true
+          (if )))
+      true))

-  (defn escape
-    "Return a new string, using cmap to escape each character ch
+(defn escape
+  "Return a new string, using cmap to escape each character ch
    from s as follows:

    If (cmap ch) is nil, append ch to the new string.
    If (cmap ch) is non-nil, append (str (cmap ch)) instead."
-    [s cmap]))+  [s cmap]
+  (let [buffer (gstring/StringBuffer.)
+        length (.length s)]
+    (loop [index 0]
+      (if (= length index)
+        (. buffer (toString))
+        (let [ch (.charAt s index)]
+          (if-let [replacement (get cmap ch)]
+            (.append buffer (str replacement))
+            (.append buffer ch))
+          (recur (inc index)))))))
+
+(comment
+
+  ;; TODO pending regexp support
+  (defn escape1
+    "Is this a better implementation for JavaScript?"
+    [s cmap]
+    (loop [ret s
+           cm cmap]
+      (let [[ch replacement] (first cmap)
+            ret (.replace ret
+                          (re-pattern (str "/" ch "/g"))
+                          (str replacement))]
+        (if (next cm)
+          (recur ret (rest cm))
+          ret))))


Groups

Groups

--- src/clojure/yaw/world.clj
+++ src/clojure/yaw/world.clj
@@ -166,6 +166,19 @@
   [world]
   (.removeSkybox world))

+;;GROUP MANAGEMENT---------------------------------------------------------
+(defn groups "Retrieve the groups of the `world`" [world] (into [] (.getItemGroupArrayList world)))
+
+(defn new-group!
+  "Get a new group created in the `world`"
+  [world]
+  (.createGroup world))
+
+(defn remove-group!
+  "Remove the specified group from the `world`"
+  [world group]
+  (.removeGroup world group))
+
 ;; Item/camera Manipulation ------------------------------------------------
 (defn rotate! [item & {:keys [x y z]
                        :or   {x 0


cleanup

cleanup

--- test/cia/handler_test.clj
+++ test/cia/handler_test.clj
@@ -1171,32 +1171,32 @@
             indicators (:parsed-body response)]
         (is (= 200 (:status response)))
         (is (deep=
-             (set #{{:title "indicator"
-                     :judgements [{:judgement (:id judgement-2)}]
-                     :sightings [{:timestamp #inst "2016-02-04T12:00:00.000-00:00"
-                                  :source "spam"
-                                  :confidence "None"}]
-                     :description "description"
-                     :producer "producer"
-                     :type ["C2" "IP Watchlist"]
-                     :valid_time {:start_time #inst "2016-01-12T00:00:00.000-00:00"
-                                  :end_time #inst "2016-02-12T00:00:00.000-00:00"}
-                     :owner "foouser"}
-                    {:title "indicator"
-                     :judgements [{:judgement (:id judgement-3)
-                                   :confidence "High"}]
-                     :sightings [{:timestamp #inst "2016-02-05T01:00:00.000-00:00"
-                                  :source "foo"
-                                  :confidence "High"}
-                                 {:timestamp #inst "2016-02-05T02:00:00.000-00:00"
-                                  :source "bar"
-                                  :confidence "Low"}]
-                     :description "description"
-                     :producer "producer"
-                     :type ["C2" "IP Watchlist"]
-                     :valid_time {:start_time #inst "2016-01-11T00:00:00.000-00:00"
-                                  :end_time #inst "2016-02-11T00:00:00.000-00:00"}
-                     :owner "foouser"}})
+             #{{:title "indicator"
+                :judgements [{:judgement (:id judgement-2)}]
+                :sightings [{:timestamp #inst "2016-02-04T12:00:00.000-00:00"
+                             :source "spam"
+                             :confidence "None"}]
+                :description "description"
+                :producer "producer"
+                :type ["C2" "IP Watchlist"]
+                :valid_time {:start_time #inst "2016-01-12T00:00:00.000-00:00"
+                             :end_time #inst "2016-02-12T00:00:00.000-00:00"}
+                :owner "foouser"}
+               {:title "indicator"
+                :judgements [{:judgement (:id judgement-3)
+                              :confidence "High"}]
+                :sightings [{:timestamp #inst "2016-02-05T01:00:00.000-00:00"
+                             :source "foo"
+                             :confidence "High"}
+                            {:timestamp #inst "2016-02-05T02:00:00.000-00:00"
+                             :source "bar"
+                             :confidence "Low"}]
+                :description "description"
+                :producer "producer"
+                :type ["C2" "IP Watchlist"]
+                :valid_time {:start_time #inst "2016-01-11T00:00:00.000-00:00"
+                             :end_time #inst "2016-02-11T00:00:00.000-00:00"}
+                :owner "foouser"}}
              (->> indicators
                   (map #(dissoc % :id :created :modified))
                   set))))))


Update tests to new scheme.

Update tests to new scheme.


Typos and rewording

Typos and rewording

--- src/cylon/oauth/server/server.clj
+++ src/cylon/oauth/server/server.clj
@@ -44,8 +44,7 @@
   (start [component]
     ;; It is essential that the authentication-handshake has the same
     ;; session store as this component, otherwise we won't be
-    ;; able to access the authentication outcome when this
-    ;; handler is called again.
+    ;; able to access the authentication when this handler is called again.
     (assert (= (:session-store authentication-handshake) session-store))

     (s/validate
@@ -74,7 +73,7 @@
           ;; If we aren't authenticated, we hand off to the
           ;; authentication process, which will honor an existing
           ;; session or create a new one if one doesn't already
-          ;; exist. Since we what to remember certain details of this
+          ;; exist. Since we want to remember certain details of this
           ;; authorization request, we elect to create the session
           ;; here. The authentication will return to this same handler.


(TK-20) Simplify retrieval of endpoints

(TK-20) Simplify retrieval of endpoints

Simplify retrieval of endpoints by allowing
get-endpoint-from-config to use :default for the route-id if
a nil route-id is passed in. Also, remove use of defaults in
implementations of handler service functions.

--- src/puppetlabs/trapperkeeper/services/webrouting/webrouting_service_core.clj
+++ src/puppetlabs/trapperkeeper/services/webrouting/webrouting_service_core.clj
@@ -2,10 +2,6 @@
   (:import (javax.servlet ServletContextListener))
   (:require [schema.core :as schema]
             [puppetlabs.trapperkeeper.services.webserver.jetty9-config :as config]))
-
-(def server-and-route-defaults
-  {:server-id :default
-   :route-id  :default})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Schemas
@@ -42,6 +38,9 @@
 (defn get-endpoint-from-config
   [context svc route-id]
   (let [config (:web-router-service context)
+        route-id (if (nil? route-id)
+                   :default
+                   route-id)
         endpoint (get-in config [svc route-id])]
     (if (nil? endpoint)
       (throw
@@ -70,60 +69,48 @@
    svc :- schema/Keyword
    base-path
    options :- ContextHandlerOptions]
-  (let [defaults               (assoc server-and-route-defaults
-                                 :context-listeners [])
-        opts                   (merge defaults options)
-        route-id               (:route-id opts)
+  (let [route-id               (:route-id options)
         context-path           (get-endpoint-from-config context svc route-id)
         add-context-handler    (:add-context-handler webserver-service)
-        opts                   (dissoc opts :route-id)]
+        opts                   (dissoc options :route-id)]
     (add-context-handler base-path context-path opts)))

 (schema/defn ^:always-validate add-ring-handler!
   [context webserver-service
    svc :- schema/Keyword
    handler options :- ServerAndRouteOptions]
-  (let [defaults            server-and-route-defaults
-        opts                (merge defaults options)
-        route-id            (:route-id opts)
+  (let [route-id            (:route-id options)
         path                (get-endpoint-from-config context svc route-id)
         add-ring-handler    (:add-ring-handler webserver-service)
-        opts                (dissoc opts :route-id)]
+        opts                (dissoc options :route-id)]
     (add-ring-handler handler path opts)))

 (schema/defn ^:always-validate add-servlet-handler!
   [context webserver-service
    svc :- schema/Keyword
    servlet options :- ServletHandlerOptions]
-  (let [defaults               (assoc server-and-route-defaults
-                                 :servlet-init-params {})
-        opts                   (merge defaults options)
-        route-id               (:route-id opts)
+  (let [route-id               (:route-id options)
         path                   (get-endpoint-from-config context svc route-id)
         add-servlet-handler    (:add-servlet-handler webserver-service)
-        opts                   (dissoc opts :route-id)]
+        opts                   (dissoc options :route-id)]
     (add-servlet-handler servlet path opts)))

 (schema/defn ^:always-validate add-war-handler!
   [context webserver-service
    svc :- schema/Keyword
    war options :- ServerAndRouteOptions]
-  (let [defaults           server-and-route-defaults
-        opts               (merge defaults options)
-        route-id           (:route-id opts)
+  (let [route-id           (:route-id options)
         path               (get-endpoint-from-config context svc route-id)
         add-war-handler    (:add-war-handler webserver-service)
-        opts               (dissoc opts :route-id)]
+        opts               (dissoc options :route-id)]
     (add-war-handler war path opts)))

 (schema/defn ^:always-validate add-proxy-route!
   [context webserver-service
    svc :- schema/Keyword
    target options :- ProxyRouteOptions]
-  (let [defaults           server-and-route-defaults
-        opts               (merge defaults options)
-        route-id           (:route-id opts)
+  (let [route-id           (:route-id options)
         path               (get-endpoint-from-config context svc route-id)
         add-proxy-route    (:add-proxy-route webserver-service)
-        opts               (dissoc opts :route-id)]
+        opts               (dissoc options :route-id)]
     (add-proxy-route target path opts)))


ws interceptor replaced by an interceptor chain to support hooks suchs as uid and before/affter

--- src/clj/hellhound/http/websocket.clj
+++ src/clj/hellhound/http/websocket.clj
@@ -105,11 +105,11 @@
 ;;   "Add websocket endpoints to the given `service-map`."
 ;;   [service-map {:keys [packer url] :as options}])

-(defn non-websocket-request
-  [msg]
+(defn bad-request
+  [{:keys [request]}]
   {:status 400
    :headers {"content-type" "application/text"}
-   :body (str "Expected a websocket request. Error: " msg)})
+   :body (str "Expected a websocket request.")})

 ;; (defn setup-event-router
@@ -128,42 +128,35 @@
   (stream/connect-via input
                       #(send->user #(pred uid %) % output)
                       output))
+
 (defn accept-ws
-  [request input output send->user?]
-  (let [uid (generate-uuid request)]
-    (->
-     (deferred/chain
-       (http/websocket-connection request)
-       (setup-user-connection uid input output send->user?)
-       #(stream/connect % output)
-       (fn [_] {:status 101}))
-     (deferred/catch
-         Exception
-         ;; TODO: We need to return the exception message
-         ;; instead of its instance.
-         (fn [e] (non-websocket-request (.getMessage e)))))))
+  [{:keys [request input output uid send->user?] :as context}]
+  (->
+   (deferred/chain
+     (http/websocket-connection request)
+     (setup-user-connection uid input output send->user?)
+     #(stream/connect % output)
+     (fn [_] {:status 101}))
+   (deferred/catch
+       Exception
+       ;; TODO: We need to return the exception message
+       ;; instead of its instance.
+       (fn [e] (non-websocket-request (.getMessage e))))))

 (defn ws
-  [{:keys [hooks input output request] :as context}]
-  (log/info "Accpting WS connection")
-  ;; TODO: Introduce hooks for authentication and authorization of
-  ;; Websocket connection.
-  ;;
-  ;; By default we would need a token base authentication.
-  (let [{:keys [before-ws-hook
-                user-id-hook
-                after-ws-hook]} hooks
-        uid     (user-id-hook context)]
+  [{:keys [uid] :as context}]
+  (if-not uid
+    (assoc context
+           :response
+           (bad-request context))
+    (assoc context
+           :response
+           @(accept-ws context))))

-    (before-ws-connect context uid)
-    (after-ws-connect context uid))
+(defn interceptor-factory
+  []
+  [{:name ::websocket-user-id-interceptor
+    :enter (get-or-create-user-id)}

-  (assoc context
-         :response
-         @(accept-ws context send->user?)))
-
-;; TODO: we need to return a correct response in this
-;; interceptor
-(def interceptor
-  {:name ::interceptor
-   :enter ws})
+   {:name ::websocket-interceptor
+    :enter ws}])


add more issuer info to user endorsements

--- src/clj/salava/badge/endorsement.clj
+++ src/clj/salava/badge/endorsement.clj
@@ -1,9 +1,10 @@
 (ns salava.badge.endorsement
   (:require [yesql.core :refer [defqueries]]
-            [salava.core.util :refer [get-db md->html]]
+            [salava.core.util :refer [get-db md->html get-full-path]]
             [slingshot.slingshot :refer :all]
             [clojure.tools.logging :as log]
-            [salava.badge.main :refer [send-badge-info-to-obf]]))
+            [salava.badge.main :refer [send-badge-info-to-obf]]
+            [salava.user.db :as user]))

 (defqueries "sql/badge/main.sql")

@@ -15,7 +16,7 @@
     (= owner user-id)))

 (defn endorsement-owner? [ctx endorsement-id user-id]
-  (let [owner (select-endorsement-owner {:id endorsement-id} (into {:result-set-fn first :row-fn :endorser_id} (get-db ctx)))]
+  (let [owner (select-endorsement-owner {:id endorsement-id} (into {:result-set-fn first :row-fn :issuer_id} (get-db ctx)))]
     (= owner user-id)))

 (defn request-endorsement [])
@@ -24,12 +25,15 @@
   (try+
     (if (badge-owner? ctx user-badge-id user-id)
       (throw+ {:status "error" :message "User cannot endorse himself"})
-      (when-let [id (->> (insert-user-badge-endorsement<! {:user_badge_id user-badge-id
-                                                           :external_id (generate-external-id)
-                                                           :endorser_id user-id
-                                                           :content content} (get-db ctx))
-                         :generated_key)]
-        {:id id :status "success"}))
+      (let [endorser-info (user/user-information ctx user-id)]
+        (when-let [id (->> (insert-user-badge-endorsement<! {:user_badge_id user-badge-id
+                                                             :external_id (generate-external-id)
+                                                             :issuer_id user-id
+                                                             :issuer_name (str (:first_name endorser-info) " " (:last_name endorser-info))
+                                                             :issuer_url (str (get-full-path ctx) "/user/profile/" user-id)
+                                                             :content content} (get-db ctx))
+                           :generated_key)]
+          {:id id :status "success"})))
     (catch Object _
       (log/error _)
       {:status "error"})))


Add debug message for when scheduling finishes.

--- src/cljs/rhapsody/lib/web_audio.cljs
+++ src/cljs/rhapsody/lib/web_audio.cljs
@@ -33,7 +33,9 @@
          (update :pitch temperament/equal)
          (dissoc :time)
          instrument
-         (play! duration (+ time at))))))
+         (play! duration (+ time at))))
+   (when debug
+     (js/console.log "Scheduling finished: " (now)))))

 (defn loop!
   ([live-fn]


Moved file I/O outside main function.

Moved file I/O outside main function.

--- src/clojure/bookmark_writer/core.clj
+++ src/clojure/bookmark_writer/core.clj
@@ -11,8 +11,8 @@
   (:require [clojure.tools.logging :as log])
   (:gen-class))

-(def ^:private template-filename "test/test.docx")
-(def ^:private output-filename "test/testoutput.safetodelete.docx")
+(def ^:private test-filename "test/test.docx")
+(def ^:private test-output-filename "test/testoutput.safetodelete.docx")
 (def ^:private bookmark-map { "BM_Text"             "#THIS TEXT WAS INSERTED INTO BOOKMARK \"BM_Text\"#",
                               "BM_NoText"           "#THIS TEXT WAS INSERTED INTO BOOKMARK \"BM_NoText\"#",
                               "BM_InTable"          "#THIS TEXT WAS INSERTED INTO BOOKMARK \"BM_InTable\"#",
@@ -39,8 +39,8 @@
   [input-document
    output-document
    bookmark-map]
-  (let [template-document (org.docx4j.Docx4J/load (clojure.java.io/file input-document))]
-    (replace-bookmark-text! template-document bookmark-map)
+  (let [template-document (org.docx4j.Docx4J/load input-document)]
+    (replace-bookmark-text! template-document bookmark-map)
     (org.docx4j.Docx4J/save template-document (clojure.java.io/file output-document) org.docx4j.Docx4J/FLAG_SAVE_ZIP_FILE)))

 (defn -main
@@ -49,4 +49,4 @@
   ;; work around dangerous default behaviour in Clojure
   (alter-var-root #'*read-eval* (constantly false))

-  (populate-bookmarks! template-filename output-filename bookmark-map))
+  (populate-bookmarks! (clojure.java.io/file test-filename) test-output-filename bookmark-map))


Make external-reader/-writer specs more verbose

Based on advice from Alex Miller. Previous version was taking advantage
of undocumented features that are subject to change without notice.

Hopefully the approach with the keywords continues to work as
expected. It still passes unit tests here.

--- src/com/frereth/common/async_zmq.clj
+++ src/com/frereth/common/async_zmq.clj
@@ -32,24 +32,24 @@
 ;; If I try to us mq-cmn for the ns component, I get an Exception
 ;; "Unable to resolve spec".
 ;; TODO: publish a minimal reproduction to mailing list.
-(s/fdef ::external-reader
-        :args (s/cat :sock :cljeromq.common/testable-read-socket)
-        ;; The mock external reader that I'm using for unit tests
-        ;; is calling deserialize on the raw bytes being generated
-        ;; by the mock socket.
-        ;; So it's generally returning strings,
-        ;; and really could return pretty much any clojure object
-        ;; This seems mostly reasonable, though I'd rather start
-        ;; by supplying it with useful values to deserialize.
-        ;; It would be nice to narrow this down a bit more,
-        ;; but I'm not sure there are good alternatives.
-        ;; Since a big chunk of that point is to move the decision
-        ;; about the actual wire protocol out to clients.
-        :ret any?)
-(s/fdef ::external-writer
-        :args (s/cat :sock :cljeromq.common/testable-write-socket
-                     :frames :cljeromq.common/byte-array-seq)
-        :ret any?)
+(def external-reader (s/fspec :args (s/cat :sock :cljeromq.common/testable-read-socket)
+                              ;; The mock external reader that I'm using for unit tests
+                              ;; is calling deserialize on the raw bytes being generated
+                              ;; by the mock socket.
+                              ;; So it's generally returning strings,
+                              ;; and really could return pretty much any clojure object
+                              ;; This seems mostly reasonable, though I'd rather start
+                              ;; by supplying it with useful values to deserialize.
+                              ;; It would be nice to narrow this down a bit more,
+                              ;; but I'm not sure there are good alternatives.
+                              ;; Since a big chunk of that point is to move the decision
+                              ;; about the actual wire protocol out to clients.
+                              :ret any?))
+(s/def ::external-reader external-reader)
+(def external-writer (s/fspec :args (s/cat :sock :cljeromq.common/testable-write-socket
+                                           :frames :cljeromq.common/byte-array-seq)
+                              :ret any?))
+(s/def ::external-writer external-writer)
 (s/def ::in-chan :com.frereth.common.async-component/async-channel)

 (s/def ::interface (s/keys :req-un [::ex-sock


Fix test

Fix test

--- test/doctopus/db_test.clj
+++ test/doctopus/db_test.clj
@@ -66,7 +66,7 @@
       (is (= 5 (count (get-all-tentacles))) "We should have 5 saved tentacles"))

     (testing "Can we save documents?"
-      (is (< 1 (count (save-document! mock-doc)))
+      (is (= 1 (save-document! mock-doc))
           "We should get back a single map representing the created doc"))

     (testing "Can we load a document by name? By URI? By tentacle?"


Allow multiple namespaces for gencompletions

--- src/main/clojure/vimclojure/gencompletions.clj
+++ src/main/clojure/vimclojure/gencompletions.clj
@@ -13,19 +13,18 @@
 ;
 ; See also: http://en.wikibooks.org/wiki/Clojure_Programming

-(ns vimclojure.gencompletions
-  (:gen-class
-     :main true))
+(ns vimclojure.gencompletions)

 (defmacro with-out-file [pathname & body]
   `(with-open [stream# (new java.io.FileWriter ~pathname)]
      (binding [*out* stream#]
        ~@body)))

-(defn -main
-  [nspace]
-  (require (symbol nspace))
-  (let [completions (keys (ns-publics (symbol nspace)))]
-    (with-out-file (str nspace "-keys.txt")
-      (doseq [x (sort completions)]
-        (println x)))))
+(defn main
+  [& nspaces]
+  (doseq [nspace nspaces]
+    (require (symbol nspace))
+    (let [completions (keys (ns-publics (symbol nspace)))]
+      (with-out-file (str "completions-" nspace ".txt")
+        (doseq [x (sort completions)]
+          (println x))))))


remove the unnecessary L's

remove the unnecessary L's

--- src-cljs/frontend/svg.cljs
+++ src-cljs/frontend/svg.cljs
@@ -4,7 +4,7 @@
             [frontend.layers :as layers]))

 (defn points->path [points]
-  (str "M" (str/join "L" (map (fn [p] (str (:rx p) " " (:ry p))) points))))
+  (str "M" (str/join " " (map (fn [p] (str (:rx p) " " (:ry p))) points))))

 (defn layer->svg-rect [camera layer shape? cast!]
   (let [layer (layers/normalized-abs-coords layer)


Enabled some additional Markdown features in the parser.

--- lambda-blog/src/lambda_blog/parsers/md.clj
+++ lambda-blog/src/lambda_blog/parsers/md.clj
@@ -22,7 +22,10 @@
        (into {})))

 (defn- do-parse [contents]
-  (try (md-to-html-string-with-meta contents)
+  (try (md-to-html-string-with-meta contents
+                                    :heading-anchors true
+                                    :reference-links? true
+                                    :footnotes? true)
        (catch java.lang.NullPointerException e
          (log/warnf "Caught an exception while parsing input file (bad metadata format?): %s" e)
          (log/debug (with-out-str (print-stack-trace e)))


change method createHelixAgent to return the agent

--- src/main/clojure/autoscaler/cluster/helix.clj
+++ src/main/clojure/autoscaler/cluster/helix.clj
@@ -51,7 +51,7 @@
    (createHelixAgent client connectString clusterName hostIp DEFAULT_AGENT_PORT))
   ([^CuratorFramework client ^String connectString ^String clusterName ^String hostIp port]
    (let [agent (createHelixAutoscalerAgent client connectString DEFAULT_HELIX_STATE_MODEL_REF (createInstanceConfig hostIp port) hostIp)]
-     (.start agent clusterName)
+     (start agent clusterName)
      agent)))

 (def singleHelixAgent (memoize createHelixAgent))


adds a browser repl

adds a browser repl

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -1,5 +1,7 @@
 (ns frontend.core
   (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
+            ;; XXX remove browser repl in prod
+            [clojure.browser.repl :as repl]
             [dommy.core :as dommy]
             [goog.dom.DomHelper]
             [frontend.components.app :as app]


reorder function declarations

reorder function declarations

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -161,17 +161,17 @@

 ;; hardware control

-(defn set-exposure [camera exp]
-  (when (not= exp (get-in @state [camera :exposures]))
-    (device-best-effort (core setExposure exp))
-    (swap! state assoc-in [camera :exposures] exp)))
-
 (defn wait-for-device [dev]
   (when-not (empty? dev)
     (try
       (core waitForDevice dev)
       (swap! pending-devices disj dev)
       (catch Exception e (log "wait for device" dev "failed.")))))
+
+(defn set-exposure [camera exp]
+  (when (not= exp (get-in @state [camera :exposures]))
+    (device-best-effort (core setExposure exp))
+    (swap! state assoc-in [camera :exposures] exp)))

 (defn wait-for-pending-devices []
   (log "pending devices: " @pending-devices)


require clojure.set

require clojure.set

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -27,6 +27,7 @@
            get-property-value]]
         [org.micromanager.sequence-generator :only [generate-acq-sequence
                                                     make-property-sequences]])
+  (:require [clojure.set])
   (:import [org.micromanager AcqControlDlg]
            [org.micromanager.api AcquisitionEngine TaggedImageAnalyzer]
            [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcq TaggedImageQueue


:dependencies should never include clojure

1.8 will break shadow-cljs and we should ever only use the
version declared by shadow-cljs itself

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -184,8 +184,13 @@
       (println "shadow-cljs - error" (.-message ex)))
     ))

+(defn check-dependencies! [{:keys [dependencies] :as config}]
+  (when (seq (filter #(= 'org.clojure/clojure (first %)) dependencies))
+    (throw (ex-info "Please remove org.clojure/clojure from your :dependencies." {}))))
+
 (defn run-standalone
   [project-root {:keys [cache-root source-paths jvm-opts] :as config} args]
+  (check-dependencies! config)
   (let [aot-path
         (path/resolve project-root cache-root "aot-classes")


Use clj-time functions rather than standard Java objects

We were previously creating a java.util.Date instance to get the
current time. Because we're trying to avoid using standard Java date
libraries in favor of Joda Time (via clj-time), it's better to use the
function that clj-time provides us. Also, the function `now` is more
semantic than the implicit behavior of `(java.util.Date.)` to use the current
time.

--- test/com/puppetlabs/cmdb/test/scf/storage.clj
+++ test/com/puppetlabs/cmdb/test/scf/storage.clj
@@ -7,6 +7,8 @@
         [com.puppetlabs.cmdb.scf.migrate :only [migrate!]]
         [clojure.test]
         [clojure.math.combinatorics :only (combinations)]
+        [clj-time.core :only [now]]
+        [clj-time.coerce :only [to-timestamp]]
         [com.puppetlabs.jdbc :only [query-to-vec]]
         [com.puppetlabs.cmdb.testutils :only [test-db]]))

@@ -161,7 +163,7 @@
         (migrate!)
         (add-certname! certname)
         (let [hash (add-catalog! catalog)]
-          (associate-catalog-with-certname! hash certname (java.util.Date.)))
+          (associate-catalog-with-certname! hash certname (now)))

         (testing "should contain proper catalog metadata"
           (is (= (query-to-vec ["SELECT cr.certname, c.api_version, c.catalog_version FROM catalogs c, certname_catalogs cr WHERE cr.catalog=c.hash"])
@@ -218,7 +220,7 @@
           (migrate!)
           (add-certname! certname)
           (let [hash (add-catalog! catalog)]
-            (replace-catalog! catalog (java.util.Date.))
+            (replace-catalog! catalog (now))

             (is (= (query-to-vec ["SELECT name FROM certnames"])
                    [{:name certname}]))
@@ -235,12 +237,12 @@
                 prev-new-num  (.count (:new-catalog metrics))]

             ;; Do an initial replacement with the same catalog
-            (replace-catalog! catalog (java.util.Date.))
+            (replace-catalog! catalog (now))
             (is (= 1 (- (.count (:duplicate-catalog metrics)) prev-dupe-num)))
             (is (= 0 (- (.count (:new-catalog metrics)) prev-new-num)))

             ;; Store a second catalog, with the same content save the version
-            (replace-catalog! (assoc catalog :version "abc123") (java.util.Date.))
+            (replace-catalog! (assoc catalog :version "abc123") (now))
             (is (= 2 (- (.count (:duplicate-catalog metrics)) prev-dupe-num)))
             (is (= 0 (- (.count (:new-catalog metrics)) prev-new-num)))

@@ -306,8 +308,8 @@
           (let [hash1 (add-catalog! catalog)
                 ;; Store the same catalog for a different host
                 hash2 (add-catalog! (assoc catalog :certname "myhost2.mydomain.com"))]
-            (associate-catalog-with-certname! hash1 certname (java.util.Date.))
-            (associate-catalog-with-certname! hash2 "myhost2.mydomain.com" (java.util.Date.))
+            (associate-catalog-with-certname! hash1 certname (now))
+            (associate-catalog-with-certname! hash2 "myhost2.mydomain.com" (now))
             (delete-catalog! hash1))

           ;; myhost should still be present in the database
@@ -346,7 +348,7 @@
           (migrate!)
           (add-certname! certname)
           (let [hash1 (add-catalog! catalog)]
-            (associate-catalog-with-certname! hash1 certname (java.util.Date.))
+            (associate-catalog-with-certname! hash1 certname (now))
             (delete-catalog! hash1))

           ;; All the params should still be there
@@ -358,7 +360,7 @@
           (migrate!)
           (add-certname! certname)
           (let [hash1 (add-catalog! catalog)]
-            (associate-catalog-with-certname! hash1 certname (java.util.Date.))
+            (associate-catalog-with-certname! hash1 certname (now))
             (delete-catalog! hash1))
           (garbage-collect!)

@@ -372,7 +374,7 @@
           (migrate!)
           (add-certname! certname)
           (let [hash1 (add-catalog! catalog)]
-            (associate-catalog-with-certname! hash1 certname (java.util.Date.))
+            (associate-catalog-with-certname! hash1 certname (now))
             (dissociate-catalog-with-certname! hash1 certname))

           (is (= (query-to-vec ["SELECT * FROM certname_catalogs"])
@@ -386,7 +388,7 @@
           (migrate!)
           (add-certname! certname)
           (let [hash1 (add-catalog! catalog)]
-            (associate-catalog-with-certname! hash1 certname (java.util.Date.))
+            (associate-catalog-with-certname! hash1 certname (now))
             (dissociate-catalog-with-certname! hash1 certname))
           (garbage-collect!)

@@ -449,8 +451,8 @@

       (testing "auto-reactivated based on a command"
         (let [one-day             (* 24 60 60 1000)
-              before-deactivating (java.util.Date. (- (System/currentTimeMillis) one-day))
-              after-deactivating  (java.util.Date. (+ (System/currentTimeMillis) one-day))]
+              before-deactivating (to-timestamp (- (System/currentTimeMillis) one-day))
+              after-deactivating  (to-timestamp (+ (System/currentTimeMillis) one-day))]
           (testing "should activate the node if the command happened after it was deactivated"
             (deactivate-node! certname)
             (is (= true (maybe-activate-node! certname after-deactivating)))
@@ -465,5 +467,5 @@

           (testing "should do nothing if the node is already active"
             (activate-node! certname)
-            (is (= true (maybe-activate-node! certname (java.util.Date.))))
+            (is (= true (maybe-activate-node! certname (now))))
             (is (= (query-certnames) [{:name certname :deactivated nil}]))))))))


Warn on fileset merge conflicts

Warn on fileset merge conflicts

- fixes #361
- fixes #364

--- boot/pod/src/boot/tmpdir.clj
+++ boot/pod/src/boot/tmpdir.clj
@@ -15,7 +15,7 @@
 (set! *warn-on-reflection* true)

 (def CACHE_VERSION "1.0.0")
-(def state (atom {:prev {} :cache {}}))
+(def state         (atom {:prev {} :cache {}}))

 ;; records and protocols ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -208,6 +208,15 @@
        :removed (->> (set/difference   x y) (select-keys t1) (assoc after :tree))
        :changed (->> (set/intersection x y) (select-keys t2) (assoc after :tree))})))

+(defn- fatal-conflict?
+  [^File dest]
+  (if (.isDirectory dest)
+    (let [tree (->> dest file-seq reverse)]
+      (or (not (every? #(.isDirectory ^File %) tree))
+          (doseq [^File f tree] (.delete f))))
+    (not (let [d (.getParentFile dest)]
+           (or (.isDirectory d) (.mkdirs d))))))
+
 ;; fileset implementation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defrecord TmpFileSet [dirs tree blob scratch]
@@ -225,9 +234,14 @@
           (when (.exists ^File (file prev))
             (util/dbug "Removing %s...\n" (path prev))
             (file/delete-file (file prev))))
-        (doseq [tmpf (set/union (ls added) (ls changed))]
+        (doseq [tmpf (->> (set/union (ls added) (ls changed))
+                          (sort-by (comp count path) >))]
           (util/dbug "Adding %s...\n" (path tmpf))
-          (file/copy-with-lastmod (io/file (bdir tmpf) (id tmpf)) (file tmpf)))
+          (let [src (io/file (bdir tmpf) (id tmpf))
+                dst (file tmpf)]
+            (if (fatal-conflict? dst)
+              (util/warn "Merge conflict: %s\n" (path tmpf))
+              (file/hard-link src dst))))
         (swap! state assoc-in [:prev dirs] this))))

   (rm [this tmpfiles]


database now has a built in db ref and doesn't require one to be passed in

--- src/subrosa/database.clj
+++ src/subrosa/database.clj
@@ -2,7 +2,7 @@
   (:refer-clojure :exclude [get])
   (:import [java.util UUID]))

-(defonce db (atom {}))
+(defonce db (ref {}))

 (defn ensure-id [m]
   (if (:id m)
@@ -10,22 +10,24 @@
     (assoc m :id (str (UUID/randomUUID)))))

 (defn get
-  ([db table]
-     (vals (get-in db [table :id])))
-  ([db table column value]
-     (get-in db [table column value])))
+  ([table]
+     (vals (get-in @db [table :id])))
+  ([table column value]
+     (get-in @db [table column value])))

-(defn put [db table m]
-  (let [m (ensure-id m)]
-    (reduce (fn [a [k v]]
-              (update-in a [table k] assoc v m))
-            db
-            m)))
+(defn delete [table id]
+  (dosync
+   (let [m (get table :id id)]
+     (alter db assoc table (reduce (fn [a [k v]]
+                                     (update-in a [k] dissoc v))
+                                   (@db table)
+                                   m)))))

-(defn delete [db table id]
-  (let [m (get db table :id id)]
-    (assoc db
-      table (reduce (fn [a [k v]]
-                      (update-in a [k] dissoc v))
-                    (db table)
-                    m))))
+(defn put [table m]
+  (dosync
+   (let [m (ensure-id m)]
+     (delete table (:id m))
+     (alter db assoc table (reduce (fn [a [k v]]
+                                     (update-in a [k] assoc v m))
+                                   (@db table)
+                                   m)))))


day 24

day 24

--- src/adventofcode/day24.clj
+++ src/adventofcode/day24.clj
@@ -1,18 +1,23 @@
 (ns adventofcode.day24
   (:require [clojure.math.combinatorics :as combo]))

-(def presents #{1 2 3 5 7 13 17 19 23 29 31 37 41 43 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113})
+(def presents [1 2 3 5 7 13 17 19 23 29 31 37 41 43 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113])
+(def presents-count (count presents))
+(def total-weight (apply + presents))

-#_(def part-one (->> (combo/partitions presents :min 3 :max 3)
-                     count
-                     #_(filter #(and
-                                 (every? (fn [coll] (< 1 (count coll))) %)
-                                 (apply = (map (partial apply +) %))))))
+(combo/combinations presents 4)
+(defn min-qe [parts n]
+  (let [qes (->> (combo/combinations presents n)
+                 (filter #(= (apply + %) (/ total-weight parts)))
+                 (pmap #(apply * %)))]
+    (when-not (empty? qes)
+      (apply min qes))))

-(comment (filter #(->> %
-                       (map (partial apply +))
-                       (apply =))
-                 [[[1] [2] [3]]
-                  [[1 2] [0 3] [3]]])
+(defn answer [parts]
+  (loop [n 0]
+    (if-let [qe (min-qe parts n)]
+      qe
+      (recur (inc n)))))

-         (count (take-while #(< (count %) 4) (combo/subsets (into [] presents)))))
+(def part-one (answer 3))
+(def part-two (answer 4))


code cleanup

code cleanup

--- src/metabase/models/interface.clj
+++ src/metabase/models/interface.clj
@@ -5,6 +5,7 @@
             [korma.core :as k]
             [medley.core :as m]
             [metabase.config :as config]
+            metabase.db.internal
             [metabase.util :as u]))

 ;;; ## ---------------------------------------- ENTITIES ----------------------------------------
@@ -81,18 +82,18 @@
                            [`(~k ~obj-binding) `(update-in [~k] ~f)])
                          fns)))))

-(defn -invoke-entity [entity id]
-  (future
-    (when (metabase.config/config-bool :mb-db-logging)
-      (clojure.tools.logging/debug
-       "DB CALL: " (:name entity) id)))
+(defn -invoke-entity
+  "Basically the same as `(sel :one Entity :id id)`." ; TODO - deduplicate with sel
+  [entity id]
+  (when (metabase.config/config-bool :mb-db-logging)
+    (clojure.tools.logging/debug
+     "DB CALL: " (:name entity) id))
   (let [[obj] (k/select (assoc entity :fields (::default-fields entity))
                         (k/where {:id id})
                         (k/limit 1))]
-    (when obj
-      (->> obj
-           (internal-post-select entity)
-           (post-select entity)))))
+    (some->> obj
+             (internal-post-select entity)
+             (post-select entity))))

 (defn- update-updated-at [obj]
   (assoc obj :updated_at (u/new-sql-timestamp)))


[Fix #211] Add the footnotes extension

[Fix #211] Add the footnotes extension

--- src/io/perun/markdown.clj
+++ src/io/perun/markdown.clj
@@ -30,7 +30,8 @@
    :tasklistitems        Extensions/TASKLISTITEMS
    :extanchorlinks       Extensions/EXTANCHORLINKS
    :all-optionals        Extensions/ALL_OPTIONALS
-   :all-with-optionals   Extensions/ALL_WITH_OPTIONALS})
+   :all-with-optionals   Extensions/ALL_WITH_OPTIONALS
+   :footnotes            Extensions/FOOTNOTES})

 (defn extensions-map->int [opts]
   (->> opts


Update fn name in docstrings: "run-state" -> "run"

When the state monad was re-added in https://github.com/funcool/cats/pull/210, `*-state` functions were renamed to `*` (https://github.com/funcool/cats/pull/210#issue-164197580) but `run-state` was not updated to `run` in a few docstrings.

--- src/cats/monad/state.cljc
+++ src/cats/monad/state.cljc
@@ -141,7 +141,7 @@
                             y (put-state (inc x))]
                        (return y)))
     (def initial-state 1)
-    (run-state computation initial-state)
+    (run computation initial-state)
   This should return something to: #<Pair [1 2]>"
   [state seed]
   ((p/-extract state) seed))
@@ -151,7 +151,7 @@
   wrapped computation and return the resultant
   value, ignoring the state.
   Equivalent to taking the first value of the pair instance
-  returned by `run-state` function."
+  returned by `run` function."
   [state seed]
   (first (run state seed)))

@@ -160,7 +160,7 @@
   wrapped computation and return the resultant
   state.
   Equivalent to taking the second value of the pair instance
-  returned by `run-state` function."
+  returned by `run` function."
   [state seed]
   (second (run state seed)))


Show output responses with time-based left padding.

--- src/cbfg/world-fence.cljs
+++ src/cbfg/world-fence.cljs
@@ -46,7 +46,13 @@
                                              " " (:fence request) "	"
                                              " " (:op request) "	"
                                              " " (filter-r request) "	"
-                                             " " (map filter-r responses) "	"
+                                             "
"
+                                             (map (fn [[out-time response]]
+                                                    ["
"
+                                                     (filter-r response)
+                                                     "
"])
+                                                  responses)
+                                             "
	"
                                              "
"])
                                           (sort #(compare (first %1) (first %2)) client-cmds))
                                      "
"]))))
@@ -74,7 +80,7 @@
                                                 (recur (inc num-ins) num-outs))
                                 (= ch out-ch) (do (render-client-cmds (swap! client-cmds
                                                                              #(update-in % [(:opaque-id v) 1]
-                                                                                conj v)))
+                                                                                conj [num-outs v])))
                                                   (recur num-ins (inc num-outs))))))
                   (make-fenced-pump world in-ch out-ch @example-max-inflight)))
               el-prefix nil)))


dagre: scale edges, too.

dagre: scale edges, too.

--- src/cfg/layout/dagre.cljs
+++ src/cfg/layout/dagre.cljs
@@ -41,7 +41,7 @@
   (.setEdge g (str (:src edge)) (str (:dst edge))))

-(defn scale-props
+(defn- scale-node-props
   [bb]
   {:x (scale-down (get bb "x"))
    :y (scale-down (get bb "y"))
@@ -52,12 +52,23 @@

 (defn get-nodes
   [g]
-  (map scale-props (vals (js->clj (aget g "_nodes")))))
+  (map scale-node-props (vals (js->clj (aget g "_nodes")))))
+
+
+(defn- scale-point-props
+  [point]
+  {:x (scale-down (get point "x"))
+   :y (scale-down (get point "y"))})
+
+
+(defn- scale-edge-props
+  [edge]
+  {:points (mapv scale-point-props (get edge "points"))})

 (defn get-edges
   [g]
-  (vals (js->clj (aget g "_edgeLabels"))))
+  (mapv scale-edge-props (vals (js->clj (aget g "_edgeLabels")))))

 (def layout! (aget dagre "layout"))


Extract the ports thing into own fn

Extract the ports thing into own fn

--- src/cider_ci/ex/trial.clj
+++ src/cider_ci/ex/trial.clj
@@ -111,6 +111,22 @@
            working-dir)
     working-dir))

+(defn- occupy-and-insert-ports [trial]
+  "Occupies free ports according to the :ports directive,
+  adds the corresponding :ports value to each script and
+  also returns the ports."
+  (let [params-atom (:params-atom trial)
+        ports (into {} (map (fn [[port-name port-params]]
+                              [port-name (port-provider/occupy-port
+                                           (or (:inet_address port-params) "localhost")
+                                           (:min port-params)
+                                           (:max port-params))])
+                            (:ports @params-atom)))
+        scripts-atoms (:scripts @params-atom)]
+    (doseq [[_ script-atom] scripts-atoms]
+      (swap! script-atom #(conj %1 {:ports %2}) ports))
+    ports))
+
 ;#### execute #################################################################
 (defn execute [params]
   (logging/info execute [params])
@@ -120,22 +136,13 @@
         params-atom (:params-atom trial)]
     (try
       (let [working-dir (create-and-insert-working-dir trial)
-            scripts-atoms (prepare-and-insert-scripts  params-atom)
-            ports (into {} (map (fn [[port-name port-params]]
-                                  [port-name (port-provider/occupy-port
-                                               (or (:inet_address port-params) "localhost")
-                                               (:min port-params)
-                                               (:max port-params))])
-                                (:ports @params-atom)))]
+            scripts-atoms (prepare-and-insert-scripts params-atom)
+            ports (occupy-and-insert-ports trial)]
         (try

           (set-and-send-start-params params-atom report-agent)

-          ; inject the ports into the scripts
-          (doseq [script-atom scripts-atoms]
-            (swap! script-atom #(conj %1 {:ports %2}) ports))
-
-          (script/process scripts-atoms  nil)
+          (script/process scripts-atoms nil)

           (attachments/put working-dir
                            (:trial_attachments @params-atom)


Cleaned up task dispatch.

Cleaned up task dispatch.

--- src/leiningen/ancient.clj
+++ src/leiningen/ancient.clj
@@ -5,6 +5,12 @@
             [leiningen.ancient.tasks.get :refer [run-get-task!]]
             [leiningen.ancient.tasks.upgrade :refer [run-upgrade-task! run-upgrade-global-task!]]
             [ancient-clj.verbose :refer :all]))
+
+(def ^:private dispatch-table
+  {"get"            run-get-task!
+   "upgrade"        run-upgrade-task!
+   "upgrade-global" run-upgrade-global-task!
+   nil              run-check-task!})

 (defn ^:no-project-needed ancient
   "Check your Projects for outdated Dependencies.
@@ -38,12 +44,10 @@
      :no-colors           Disable colorized output.
   "
   [project & args]
-  (let [t (first args)]
-    (condp = (first args)
-      "get" (run-get-task! project args)
-      "upgrade" (run-upgrade-task! project args)
-      "upgrade-global" (run-upgrade-global-task! project args)
-      (if (or (not t) (.startsWith ^String t ":"))
-        (run-check-task! project args)
-        (println (red "unknown task:") (str "'" t "'")
-                 "with parameters" (pr-str (vec (rest args))))))))
+  (let [^String t (when-let [^String t (first args)]
+                    (when-not (.startsWith t ":") t))
+        run-task! (get dispatch-table t)]
+    (when-not run-task!
+      (println (red "unknown task:") (str "'" t "'") "with parameters" (pr-str (vec (rest args))))
+      (System/exit 1))
+    (run-task! project args)))


Handle DELETE call for revisions.

Handle DELETE call for revisions.

--- src/open_company/api/sections.clj
+++ src/open_company/api/sections.clj
@@ -44,6 +44,9 @@
 (defn- patch-revision [conn company-slug section-name as-of revision author]
   {:updated-section (section-res/patch-revision conn company-slug section-name as-of revision author)})

+(defn- delete-revision [conn company-slug section-name as-of author]
+  {:updated-section (section-res/delete-revision conn company-slug section-name as-of author)})
+
 (defn- get-revision-list [conn company-slug section-name]
   (if-let [section (section-res/get-section conn company-slug section-name)]
     {:revisions (section-res/get-revisions conn company-slug section-name)}))
@@ -53,13 +56,13 @@
 (defresource section [conn company-slug section-name as-of]
   common/open-company-anonymous-resource  ; verify validity of JWToken if it's provided, but it's not required

-  :allowed-methods [:options :get :put :patch]
+  :allowed-methods [:options :get :put :patch :delete]
   :available-media-types [section-rep/media-type]
   :exists? (by-method {
                        :get (fn [_] (get-section conn company-slug section-name as-of))
                        :put (fn [_] (and (nil? as-of) (get-section conn company-slug section-name as-of)))
                        :patch (fn [_] (and (not (nil? as-of)) (get-section conn company-slug section-name as-of)))
-                       :delete (fn [_] (and (nil? as-of) (get-section conn company-slug section-name as-of)))})
+                       :delete (fn [_] (and (not (nil? as-of)) (get-section conn company-slug section-name as-of)))})

   :known-content-type? (fn [ctx] (common/known-content-type? ctx section-rep/media-type))

@@ -70,7 +73,7 @@
                         :put (fn [ctx] (common/allow-org-members conn company-slug ctx))
                         :patch (fn [ctx] (common/allow-org-members conn company-slug ctx))
                         :post false
-                        :delete false})
+                        :delete (fn [ctx] (common/allow-org-members conn company-slug ctx))})

   :can-put-to-missing? true

@@ -79,14 +82,16 @@
                             :options true
                             :get true
                             :put true
-                            :patch true})
+                            :patch true
+                            :delete true})

   ;; Handlers
   :handle-ok
     (by-method {
                 :get (fn [ctx] (section-rep/render-section conn (:section ctx) (common/allow-org-members conn company-slug ctx) (not (nil? as-of))))
                 :put (fn [ctx] (section-rep/render-section conn (:updated-section ctx)))
-                :patch (fn [ctx] (section-rep/render-section conn (:updated-section ctx)))})
+                :patch (fn [ctx] (section-rep/render-section conn (:updated-section ctx)))
+                :delete (fn [ctx] (section-rep/render-section conn (:updated-section ctx)))})
   :handle-not-acceptable (fn [_] (common/only-accept 406 section-rep/media-type))
   :handle-unsupported-media-type (fn [_] (common/only-accept 415 section-rep/media-type))
   :handle-unprocessable-entity (fn [ctx] (unprocessable-reason (:reason ctx)))
@@ -96,6 +101,7 @@
   :new? (by-method {:put (fn [ctx] (not (:section ctx)))})
   :put! (fn [ctx] (put-section conn company-slug section-name (:data ctx) (:user ctx)))
   :patch! (fn [ctx] (patch-revision conn company-slug section-name as-of (merge (:section ctx) (:data ctx)) (:user ctx)))
+  :delete! (fn [ctx] (delete-revision conn company-slug section-name as-of (:user ctx)))
   :handle-created (fn [ctx] (section-location-response conn (:updated-section ctx))))

 ;; A resource for a list of all the revisions of the section the user has access to.


CLJS-1089: AOT analysis cache has bad :file paths

ensure that cljs.core defs always have :file "cljs/core.cljs"

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -317,14 +317,18 @@

 (defn source-info
   ([env]
-     (when-let [line (:line env)]
-       {:file *cljs-file*
-        :line (get-line name env)
-        :column (get-col name env)}))
-  ([name env]
-     {:file *cljs-file*
+   (when-let [line (:line env)]
+     {:file (if (= (-> env :ns :name) 'cljs.core)
+              "cljs/core.cljs"
+              *cljs-file*)
       :line (get-line name env)
       :column (get-col name env)}))
+  ([name env]
+   {:file (if (= (-> env :ns :name) 'cljs.core)
+            "cljs/core.cljs"
+            *cljs-file*)
+    :line (get-line name env)
+    :column (get-col name env)}))

 (defn message [env s]
   (str s (when (:line env)
@@ -793,7 +797,13 @@
           ;; elide test metadata, as it includes non-valid EDN - David
           (cond-> sym-meta
             :test (-> (dissoc :test) (assoc :test true)))
-          {:meta (dissoc sym-meta :test)}
+          {:meta (-> sym-meta
+                   (dissoc :test)
+                   (update-in [:file]
+                     (fn [f]
+                       (if (= (-> env :ns :name) 'cljs.core)
+                         "cljs/core.cljs"
+                         f))))}
           (when doc {:doc doc})
           (when dynamic {:dynamic true})
           (source-info var-name env)


CLJS-948: simplify macro usage

CLJS-948: simplify macro usage

When using or requiring a namespace that itself requires a macro file
of the same name implicitly require the library's macros using the
same provided spec information.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1224,6 +1224,13 @@
     {:import  import-map
      :require import-map}))

+(defn macro-autoload-ns? [form]
+  (let [ns (if (sequential? form) (first form) form)
+        {:keys [use-macros require-macros]}
+        (get-in @env/*compiler* [::namespaces ns])]
+    (or (contains? use-macros ns)
+        (contains? require-macros ns))))
+
 (defn desugar-ns-specs [args]
   (let [{:keys [require] :as indexed}
         (->> args
@@ -1239,7 +1246,9 @@
         to-macro-specs
         (fn [specs]
           (->> specs
-            (filter #(and (sequential? %) (some sugar-keys %)))
+            (filter #(or (and (sequential? %)
+                              (some sugar-keys %))
+                         (macro-autoload-ns? %)))
             (map #(->> % (remove-from-spec #{:include-macros})
                          (remove-from-spec #{:refer})
                          (map (fn [x] (if (= x :refer-macros) :refer x)))))))


use namespaced config

use namespaced config

--- src/org/zalando/friboo/system.clj
+++ src/org/zalando/friboo/system.clj
@@ -2,16 +2,33 @@
   (:require [org.zalando.friboo.system.http :as http]
             [com.stuartsierra.component :as component]
             [environ.core :refer [env]]
-            [clojure.tools.logging :as log])
+            [clojure.tools.logging :as log]
+            [clojure.string :refer [replace-first]])
   (:import (org.apache.logging.log4j LogManager Level)
            (org.apache.logging.log4j.core LoggerContext)
            (org.apache.logging.log4j.core.config Configuration LoggerConfig)))

+(defn- strip [namespace k]
+  (keyword (replace-first (name k) (str (name namespace) "-") "")))
+
+(defn- namespaced [config namespace]
+  (if (contains? config namespace)
+    (config namespace)
+    (into {} (map (fn [[k v]] [(strip (name namespace) k) v])
+                  (filter (fn [[k v]]
+                            (.startsWith (name k) (str (name namespace) "")))
+                          config)))))
+
+(defn parse-namespaces [config namespaces]
+  (let [namespaced-configs (into {} (map (juxt identity (partial namespaced config)) namespaces))]
+    (doseq [[namespace namespaced-config] namespaced-configs]
+      (log/debug "Destructured" namespace "into" namespaced-config))
+    namespaced-configs))
+
 (defn load-configuration
   "Loads configuration options from various places."
-  []
-  ; yes, that's enough for now
-  env)
+  [& namespaces]
+  (parse-namespaces env (conj namespaces :http :system)))

 (defn set-log-level
   "Changes the log level of the log4j2 root logger."
@@ -26,20 +43,22 @@
 (defn new-system
   "Creates a new system-map that preconfigures an HTTP server with swagger1st."
   [configuration system]
-  (let [default-system {:http (component/using (http/new-http configuration) [:api])
+  (let [default-system {:http (component/using (http/new-http (:http configuration)) [:api])
                         :api  (http/new-default-api)}]
     (component/map->SystemMap (merge default-system system))))

 (defn run
   "Boots a whole new system."
-  [configuration system]
+  [{configuration :system} system]
   (log/info "starting system...")
+
   (if-let [log-level (:log-level configuration)]
     (do
       (log/warn "setting log level to" log-level)
       (set-log-level log-level)))
-  (let [system (new-system configuration system)]
-    (log/trace "starting system")
-    (let [system (component/start system)]
-      (log/info "system started.")
-      system)))
+
+  (log/trace "starting system")
+  (let [system (component/start system)]
+
+    (log/info "system started.")
+    system))


Minor fix to tree

Minor fix to tree

--- src/clj/minijava/tree.clj
+++ src/clj/minijava/tree.clj
@@ -10,7 +10,7 @@
 (def *methods* (atom (hash-map)))

 (defn addMethod [name method frame]
-	nil;;(reset! *methods* (merge @*methods* [name {:method method :frame frame}]))
+		(reset! *methods* (assoc @*methods* name {:method method :frame frame}))
 )

 (defn binop
@@ -134,11 +134,7 @@
 (deftree minijava.ast.MainClass
   [x frame]
  (let [f (new-x86 0 ["obj"] nil)]
-(addMethod "main" (tree (.statement x) f) f ))
-
-;; {"main" (tree (.statement x) (new-x86 0 ["obj"] nil))}
-
-)
+(addMethod "main" (tree (.statement x) f) f )))

 (deftree minijava.ast.MethodDecl
   [x frame]


Print project and day on input change.

Print project and day on input change.

--- src/cljs/tunnit/core.cljs
+++ src/cljs/tunnit/core.cljs
@@ -50,8 +50,10 @@
 (defn week-dates []
   (map-kv day-map count-date))

-(defn handle-change [e]
-  (print (str "value: " (.. e -target -value))))
+(defn handle-change [e project day]
+  (print (str "value: " (.. e -target -value)
+              ", project: " (:name @project)
+              ", day: " day)))

 (defcomponent project-entries [app]
   (render [this]
@@ -61,8 +63,7 @@
                      (ot/input {
                                 :class "project-name"
                                 :type "text"
-                                :value (:name project)
-                                :on-change #(handle-change %)})
+                                :value (:name project)})

                      (for [day (range 1 8)]
                        (let [hours
@@ -70,7 +71,7 @@
                          (ot/input {
                                     :class "hour-entry"
                                     :value hours
-                                    :on-change #(handle-change %)}
+                                    :on-change #(handle-change % project day)}
                                    )))))
            (:projects app)))))


Eliminate debugging prints

Eliminate debugging prints

--- src/oxcart/passes/lambda_lift.clj
+++ src/oxcart/passes/lambda_lift.clj
@@ -83,7 +83,6 @@

 (defn rewrite-fn*
   [form locals]
-  (println "Rewriting " form locals)
   (let [bodies (rest form)]
     `(fn* ~@(for [[params & body] bodies]
               `([~@locals ~@params]
@@ -105,11 +104,8 @@
                                       (fn*->cannonical-fn*)
                                       (rewrite-fn* used-locals)))
               partial-form `(partial ~(symbol sym) ~@used-locals)
-              def-ast      (util/ast def-form)
-              partial-ast  (util/ast partial-form
-                                     (:env ast))]
-
-          (println def-form)
+              def-ast      (util/ast def-form     (:env ast))
+              partial-ast  (util/ast partial-form (:env ast))]

           ;; create the new def
           (swap! defs-atom conj def-ast)
@@ -211,7 +207,6 @@
   [{:keys [modules] :as ast} options]
   (->> (for [module modules]
          (binding [*ns* module]
-           (println "Lifting lambdas in module" module)
            [module (lift-lambdas-in-module (get ast module))]))
        (into {})
        (merge ast)))


app.getDataPath has been replaced with app.getData

--- src/lt/objs/platform.cljs
+++ src/lt/objs/platform.cljs
@@ -11,7 +11,7 @@
 (def electron-shell (js/require "shell"))

 (defn get-data-path []
-  (.getDataPath (.require (js/require "remote") "app")))
+  (.getData (.require (js/require "remote") "app")))

 (defn normalize [plat]
   (condp = plat


fix broken function call s is now language

--- src/rdf-common/grafter/rdf/io.clj
+++ src/rdf-common/grafter/rdf/io.clj
@@ -75,7 +75,7 @@
       (str datatype))))

 (defmethod literal-datatype->type nil [literal]
-  (s (pr/raw-value literal) (pr/lang literal)))
+  (language (pr/raw-value literal) (pr/lang literal)))

 (defmethod literal-datatype->type "http://www.w3.org/2001/XMLSchema#boolean" [literal]
   (Boolean/parseBoolean (pr/raw-value literal)))


remove kevin

remove kevin


removed now dead stateful-button

removed now dead stateful-button

--- frontend/components/forms.cljs
+++ frontend/components/forms.cljs
@@ -9,8 +9,7 @@
                    [frontend.utils :refer [html]]))

-;; Version 2 of the stateful button follows. New code should prefer this version, managed-button, over the old version, stateful-button.
-;; Example usage:
+;; Example usage for managed-button:

 ;; component html:
 ;; [:form (forms/managed-button [:input {:type "submit" :on-click #(raise! owner [:my-control])}])]
@@ -141,124 +140,3 @@
    button with the data-:status-text for a second."
   [hiccup-form]
   (om/build managed-button* hiccup-form))
-
-
-;; Version 1 of the stateful button
-
-(defn tap-api
-  "Sets up a tap of the api channel and watches for the API request associated with
-  the form submission to complete.
-  Runs success-fn if the API call was succesful and failure-fn if it failed.
-  Will "
-  [api-mult api-tap uuid {:keys [success-fn failure-fn api-count]
-                          :or {api-count 1}}]
-  (async/tap api-mult api-tap)
-  (go-loop [api-calls 0 ; keep track of how many api-calls we handled
-            results #{}]
-           (let [v (<! api-tap)]
-             (let [message-uuid (:uuid (meta v))
-                   message (first v)
-                   status (second v)]
-               (cond
-                (and (= uuid message-uuid)
-                     (#{:success :failed} status))
-                (if (and (= status :success) (< (inc api-calls) api-count))
-                  (do (utils/mlog "completed" (inc api-calls) "of" api-count "api calls")
-                      (recur (inc api-calls) (conj results status)))
-                  (do (if (= #{:success} (conj results status))
-                        (success-fn)
-                        (failure-fn))
-                      ;; There's a chance of a race if the button gets clicked twice.
-                      ;; No good ideas on how to fix it, and it shouldn't happen,
-                      ;; so punting for now
-                      (async/untap api-mult api-tap)))
-
-                (nil? v) nil ;; don't recur on closed channel
-
-                :else (recur api-calls results))))))
-
-(defn cleanup
-  "Cleans up api-tap channel and stops the idle timer from firing"
-  [owner]
-  (dispose (om/get-state owner [:api-tap-id]))
-  (js/clearTimeout (om/get-state owner [:idle-timer])))
-
-(defn wrap-handler
-  "Wraps the on-click handler with a uuid binding to trace the channel passing, and taps
-  the api channel so that we can wait for the api call to finish successfully."
-  [handler owner api-count]
-  (let [api-tap (disposable/from-id (om/get-state owner [:api-tap-id]))
-        api-mult (om/get-shared owner [:comms :api-mult])]
-    (fn [& args]
-      (append-cycle owner :loading)
-      (let [uuid (utils/uuid)]
-        (binding [frontend.async/*uuid* uuid]
-          (tap-api api-mult api-tap uuid
-                   {:api-count api-count
-                    :success-fn
-                    #(append-cycle owner :success)
-                    :failure-fn
-                    #(append-cycle owner :failed)})
-          (apply handler args))))))
-
-(defn stateful-button*
-  "Takes an ordinary input or button hiccup form.
-  Disables the button while it waits for the API response to come back.
-  When the button is clicked, it replaces the button value with data-loading-text,
-  when the response comes back, it replaces the button with the data-:status-text for a second."
-  [hiccup-form owner]
-  (reify
-    om/IDisplayName (display-name [_] "Stateful button")
-    om/IInitState
-    (init-state [_]
-      {:lifecycle [:idle]
-       ;; use a sliding-buffer so that we don't block
-       :api-tap-id (disposable/register (chan (sliding-buffer 10)) close!)
-       :idle-timer nil})
-
-    om/IWillUnmount (will-unmount [_] (cleanup owner))
-
-    om/IWillUpdate
-    (will-update [_ _ {:keys [lifecycle]}]
-      (when (#{:success :failed} (last lifecycle))
-        (schedule-idle owner lifecycle)))
-
-    om/IRenderState
-    (render-state [_ {:keys [lifecycle]}]
-      (let [button-state (last lifecycle)
-            [tag attrs & rest] hiccup-form
-            data-field (keyword (str "data-" (name button-state) "-text"))
-            new-value (-> (merge {:data-loading-text "..."
-                                  :data-success-text "Saved"
-                                  :data-failed-text "Failed"}
-                                 attrs)
-                          (get data-field (:value attrs)))
-            new-body (cond (= :idle button-state) rest
-                           (:data-spinner attrs) common/spinner
-                           :else new-value)
-            api-count (get attrs :data-api-count 1) ; number of api calls to wait for
-            new-attrs (-> attrs
-                          ;; Disable the button when it's not idle
-                          ;; We're changing the value of the button, so its safer not to let
-                          ;; people click on it.
-                          (assoc :disabled (not= :idle button-state))
-                          (update-in [:class] (fn [c] (cond (= :idle button-state) c
-                                                            (string? c) (str c  " disabled")
-                                                            (coll? c) (conj c "disabled")
-                                                            :else "disabled")))
-                          ;; Update the on-click handler to watch the api channel for success
-                          (update-in [:on-click] wrap-handler owner api-count)
-                          (update-in [:value] (fn [v]
-                                                (or new-value v))))]
-        (html
-         (vec (concat [tag new-attrs]
-                      [new-body])))))))
-
-(defn stateful-button
-  "Takes an ordinary input or button hiccup form.
-   Disables the button while it waits for the API response to come back.
-   When the button is clicked, it replaces the button value with data-loading-text,
-   when the response comes back, it replaces the button with the data-:status-text for a second.
-   If the button needs to wait for multiple api calls to complete, add data-api-count"
-  [hiccup-form]
-  (om/build stateful-button* hiccup-form))


Getting a Truffle runtime seems to work.

--- src/tuber_basic/core.clj
+++ src/tuber_basic/core.clj
@@ -1,5 +1,7 @@
 (ns tuber-basic.core
-  (:gen-class))
+  (:import [com.oracle.truffle.api Truffle]))
+
+(println (.getName (Truffle/getRuntime)))

 (defn -main
   "I don't do a whole lot ... yet."


Make record-accessors preserve reader meta

--- src/useful/datatypes.clj
+++ src/useful/datatypes.clj
@@ -81,7 +81,10 @@
   "Defines optimized macro accessors using interop and typehints for all fields in the given records."
   [& types]
   `(do ~@(for [type  types
+               :let [tag (symbol (.getName (coerce-class type)))]
                field (record-fields type)]
            `(defmacro ~field [~'record]
-              (list '~(symbol (str "." field))
-                    (with-meta ~'record {:tag '~(symbol (.getName (coerce-class type)))}))))))
+              (with-meta
+                (list '. (with-meta ~'record {:tag '~tag})
+                      '~field)
+                (meta ~'&form))))))