CMR-4776: Added mock echo routes for POST get_token_info.

--- mock-echo-app/src/cmr/mock_echo/api/tokens.clj
+++ mock-echo-app/src/cmr/mock_echo/api/tokens.clj
@@ -1,12 +1,13 @@
 (ns cmr.mock-echo.api.tokens
   "Defines the HTTP URL routes for tokens."
-  (:require [compojure.core :refer :all]
-            [cheshire.core :as json]
-            [clojure.set :as set]
-            [cmr.common.log :refer (debug info warn error)]
-            [cmr.common.services.errors :as svc-errors]
-            [cmr.mock-echo.data.token-db :as token-db]
-            [cmr.mock-echo.api.api-helpers :as ah]))
+  (:require
+   [cheshire.core :as json]
+   [clojure.set :as set]
+   [cmr.common.log :refer (debug info warn error)]
+   [cmr.common.services.errors :as svc-errors]
+   [cmr.mock-echo.api.api-helpers :as ah]
+   [cmr.mock-echo.data.token-db :as token-db]
+   [compojure.core :refer :all]))

 (def token-keys
@@ -43,7 +44,7 @@
   (get-token-or-error context token-id)
   (token-db/delete context token-id))

-(defn get-token-info
+(defn- get-token-info-mock
   [context token-id]
   (let [{:keys [username client_id id]} (get-token-or-error context token-id)]
     {:token_info {:user_name username
@@ -58,7 +59,7 @@
 (def registered-user-sid
   {:sid {:user_authorization_type_sid {:user_authorization_type "REGISTERED"}}})

-(defn get-current-sids
+(defn- get-current-sids
   "Returns the groups the user who owns the token belongs to"
   [context token-id]
   (let [{:keys [username group_guids]} (get-token-or-error context token-id)]
@@ -68,6 +69,16 @@
             (map (fn [guid]
                    {:sid {:group_sid {:group_guid guid}}})
                  group_guids)))))
+
+(defn- get-token-info
+  "Returns the token info for the given token"
+  [context headers token-id]
+  (if (= "expired-token" token-id)
+    ;; echo-rest returns status code 400 for request with expired token
+    (ah/status-bad-request {:errors ["Token [expired-token] has expired."]})
+    (do
+      (ah/require-sys-admin-token headers)
+      (ah/status-ok (get-token-info-mock context token-id)))))

 (defn build-routes [system]
   (routes
@@ -80,6 +91,8 @@
            :content-type :json
            :headers {"Location" url}
            :body {:token token}}))
+      (POST "/get_token_info" {context :request-context headers :headers {token-id :id} :params}
+        (get-token-info context headers token-id))
       (context "/:token-id" [token-id]
         ;; Logout
         (DELETE "/" {context :request-context}
@@ -91,12 +104,7 @@
             ;; echo-rest returns status code 400 for request with expired token
             (ah/status-bad-request {:errors ["Token [expired-token] has expired."]})
             (ah/status-ok (get-current-sids context token-id))))
-        (GET "/token_info" {context :request-context headers :headers }
-          (if (= "expired-token" token-id)
-            ;; echo-rest returns status code 400 for request with expired token
-            (ah/status-bad-request {:errors ["Token [expired-token] has expired."]})
-            (do
-              (ah/require-sys-admin-token headers)
-              (ah/status-ok (get-token-info context token-id)))))))
+        (GET "/token_info" {context :request-context headers :headers}
+          (get-token-info context headers token-id))))
     (GET "/availability" {context :request-context}
       {:status 200})))


fix tx-range example

fix tx-range example

--- tutorial/log.clj
+++ tutorial/log.clj
@@ -41,7 +41,7 @@

 ;; What else happened at the same time (i.e. during the same transaction)
 ;; as Joe moving to Broadway?
-(d/tx-range conn {:start tx-id :end tx-id})
+(d/tx-range conn {:start tx-id :end (inc tx-id)})

 ;; Note that we see the same wall clock time we just queried for, as well
 ;; as 4 other datoms. One is the assertion of Joe moving to Broadway.
@@ -58,4 +58,4 @@

 (d/pull db '[*] ent-id)

-(repl/delete-scratch-db conn "config.edn")+(repl/delete-scratch-db conn "config.edn")


slightly loosen api reset password logic.  only check for `:old_password` if it's a non-admin updating their own password.

--- src/metabase/api/user.clj
+++ src/metabase/api/user.clj
@@ -78,7 +78,8 @@
   {password     [Required ComplexPassword]}
   (check-self-or-superuser id)
   (let-404 [user (db/select-one [User :password_salt :password], :id id, :is_active true)]
-    (when (= id *current-user-id*)
+    (when (and (not (:is_superuser @*current-user*))
+               (= id *current-user-id*))
       (checkp (creds/bcrypt-verify (str (:password_salt user) old_password) (:password user)) "old_password" "Invalid password")))
   (set-user-password id password)
   (User id))


Limit AP results to 10 rather than 20.

Limit AP results to 10 rather than 20.

--- src/oc/storage/config.clj
+++ src/oc/storage/config.clj
@@ -96,6 +96,6 @@

 (defonce inline-comment-count 10)

-(defonce default-activity-limit 20)
+(defonce default-activity-limit 10)

 (defonce whats-new-board (env :whats-new-board))


Defensively check for whether thread was interrupted

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -147,15 +147,16 @@
           _ (log/info (str "Kafka task: " task-id " allocated to partition: " kpartition ", starting at offset: " offset))
           (try
             (loop [ms (seq (poll! consumer))]
-              (if ms
-                (Thread/sleep empty-read-back-off)
-                (doseq [message ms]
-                  (let [next-offset (:offset message)
-                        dm (deserializer-fn (:value message))
-                        wrapped (wrapper-fn message dm next-offset)]
-                    (>!! ch (assoc (t/input (random-uuid) wrapped)
-                                   :offset next-offset)))))
-                (recur (seq (poll! consumer))))
+              (when-not (Thread/interrupted)
+                (if ms
+                  (Thread/sleep empty-read-back-off)
+                  (doseq [message ms]
+                    (let [next-offset (:offset message)
+                          dm (deserializer-fn (:value message))
+                          wrapped (wrapper-fn message dm next-offset)]
+                      (>!! ch (assoc (t/input (random-uuid) wrapped)
+                                     :offset next-offset)))))
+                (recur (seq (poll! consumer)))))
             (finally
               (future-cancel commit-fut))))
         (catch InterruptedException e


reset state change after test

reset state change after test

--- test/midje/t_repl.clj
+++ test/midje/t_repl.clj
@@ -517,9 +517,11 @@
   (set (keys (autotest-options))) => (contains #{:interval :files}))

 (fact "options can be set"
-  (:interval (autotest-options)) =not=> 832
-  (set-autotest-option! :interval 832)
-  (:interval (autotest-options)) => 832)
+  (let [old-interval (:interval (autotest-options))]
+    (:interval (autotest-options)) =not=> 832
+    (set-autotest-option! :interval 832)
+    (:interval (autotest-options)) => 832
+    (set-autotest-option! :interval old-interval)))

 (fact "autotest"
   (against-background (autotest-options) => ..options..


Close all open sockets when stopping app, i.e. don't be leaky!

--- src/pubsure_ws/reader.clj
+++ src/pubsure_ws/reader.clj
@@ -162,6 +162,8 @@
   (doseq [[sess-id topic-chans] @channels
           [topic _] topic-chans]
     (unsubscribe state sess-id topic))
+  (doseq [[sess-id _] @wamp/client-channels]
+    (wamp/close-channel sess-id))
   (info "Stopped the reader application."))


fix sorting chats

fix sorting chats

--- src-cljs/frontend/components/chat.cljs
+++ src-cljs/frontend/components/chat.cljs
@@ -142,7 +142,7 @@
                (list (when (or (not= 1 (count chat-groups))
                                (not= #{"Today"} (set (keys chat-groups))))
                        [:h2.chat-date time])
-                     (for [[prev-chat chat] (partition 2 1 (concat [nil] chat-group))]
+                     (for [[prev-chat chat] (partition 2 1 (concat [nil] (sort-by :server/timestamp chat-group)))]
                        (om/build chat-item chat {:key :db/id
                                                  :opts {:client-id client-id
                                                         :show-sender? (not= (chat-model/display-name prev-chat client-id)


remove unnecessary insights-selected-branch twiddling

- This is done before the request is sent, which allows the spinner to
  show up properly.

--- src-cljs/frontend/controllers/api.cljs
+++ src-cljs/frontend/controllers/api.cljs
@@ -157,8 +157,7 @@
                                           project-id (api/project-build-id project overrides)]]
                                 (if (= project-id target-id)
                                   (-> project
-                                      (assoc-in [:recent-builds (:branch target-id)] all-recent-builds)
-                                      (assoc :insights-selected-branch (:branch overrides)))
+                                      (assoc-in [:recent-builds (:branch target-id)] all-recent-builds))
                                   project)))]
       (update-in state state/projects-path add-recent-builds))
     state))


Add further docstrings. Also de-macroize blend.

--- src/rosado/processing.clj
+++ src/rosado/processing.clj
@@ -204,7 +204,13 @@
                  :quads QUADS
                  :quad-strip QUAD_STRIP})

-(defmacro begin-shape
+(defn- resolve-shape-mode
+  [mode]
+  (if (keyword? mode)
+    (get shapes-map mode)
+    mode))
+
+(defn begin-shape
   "Enables the creation of complex forms. begin-shape begins recording vertices
   for a shape and end-shape stops recording. Use the mode keyword to specify
   which shape create from the provided vertices. With no mode specified, the
@@ -223,10 +229,10 @@
   Transformations such as translate, rotate, and scale do not work within
   begin-shape. It is also not possible to use other shapes, such as ellipse
   or rect within begin-shape."
-  ([] `(.beginShape *applet*))
+  ([] (.beginShape *applet*))
   ([mode]
-     (let [kind (shapes-map mode)]
-       `(.beginShape *applet* (int ~kind)))))
+     (let [mode (resolve-shape-mode  mode)]
+       (.beginShape *applet* (int mode)))))

 (defn bezier
   "Draws a Bezier curve on the screen. These curves are defined by a series of
@@ -306,35 +312,109 @@
              :dodge DODGE
              :burn BURN})

-(defn- resolve-mode
+(defn- resolve-blend-mode
   [mode]
   (if (keyword? mode)
     (get blend-map mode)
     mode))

-(defmacro blend
-  "Blends a region of pixels from one image into another (or in itself again) with full alpha channel support."
+(defn blend
+  "Blends a region of pixels from one image into another (or in itself again)
+  with full alpha channel support.
+
+  Available blend modes are:
+
+  :blend      - linear interpolation of colours: C = A*factor + B
+  :add        - additive blending with white clip: C = min(A*factor + B, 255)
+  :subtract   - subtractive blending with black clip: C = max(B - A*factor, 0)
+  :darkest    - only the darkest colour succeeds: C = min(A*factor, B)
+  :lightest   - only the lightest colour succeeds: C = max(A*factor, B)
+  :difference - subtract colors from underlying image.
+  :exclusion  - similar to :difference, but less extreme.
+  :multiply   - Multiply the colors, result will always be darker.
+  :screen     - Opposite multiply, uses inverse values of the colors.
+  :overlay    - A mix of :multiply and :screen. Multiplies dark values, and
+                screens light values.
+  :hard-light - :screen when greater than 50% gray, :multiply when lower.
+  :soft-light - Mix of :darkest and :lightest. Works like :overlay, but not as
+                harsh.
+  :dodge      - Lightens light tones and increases contrast, ignores darks.
+                Called \"Color Dodge\" in Illustrator and Photoshop.
+  :burn       - Darker areas are applied, increasing contrast, ignores lights.
+                Called \"Color Burn\" in Illustrator and Photoshop."
   ([x y width height dx dy dwidth dheight mode]
      (let [mode (resolve-mode mode)]
-       `(.blend *applet* (int x) (int y) (int width) (int height)
-                (int dx) (int dy) (int dwidth) (int dheight) (int ~mode))))
+       (.blend *applet* (int x) (int y) (int width) (int height)
+               (int dx) (int dy) (int dwidth) (int dheight) (int mode))))
   ([^PImage src x y width height dx dy dwidth dheight mode]
      (let [mode (resolve-mode mode)]
-       `(.blend *applet* src (int x) (int y) (int width) (int height)
-                (int dx) (int dy) (int dwidth) (int dheight) (int ~mode)))))
+       (.blend *applet* src (int x) (int y) (int width) (int height)
+               (int dx) (int dy) (int dwidth) (int dheight) (int mode)))))

 (defn blend-color
-  [c1 c2 mode] (PApplet/blendColor (int c1) (int c2) (int mode)))
-
-(defn blue [what] (.blue *applet* (int what)))
+  "Blends two color values together based on the blending mode given specified
+  with the mode keyword.
+
+  Available blend modes are:
+
+  :blend      - linear interpolation of colours: C = A*factor + B
+  :add        - additive blending with white clip: C = min(A*factor + B, 255)
+  :subtract   - subtractive blending with black clip: C = max(B - A*factor, 0)
+  :darkest    - only the darkest colour succeeds: C = min(A*factor, B)
+  :lightest   - only the lightest colour succeeds: C = max(A*factor, B)
+  :difference - subtract colors from underlying image.
+  :exclusion  - similar to :difference, but less extreme.
+  :multiply   - Multiply the colors, result will always be darker.
+  :screen     - Opposite multiply, uses inverse values of the colors.
+  :overlay    - A mix of :multiply and :screen. Multiplies dark values, and
+                screens light values.
+  :hard-light - :screen when greater than 50% gray, :multiply when lower.
+  :soft-light - Mix of :darkest and :lightest. Works like :overlay, but not as
+                harsh.
+  :dodge      - Lightens light tones and increases contrast, ignores darks.
+                Called \"Color Dodge\" in Illustrator and Photoshop.
+  :burn       - Darker areas are applied, increasing contrast, ignores lights.
+                Called \"Color Burn\" in Illustrator and Photoshop."
+  [c1 c2 mode]
+  (let [mode (resolve-mode mode)]
+    (PApplet/blendColor (int c1) (int c2) (int mode))))
+
+(defn blue
+  "Extracts the blue value from a color, scaled to match current color-mode.
+  Returns a float. "
+  [color]
+  (.blue *applet* (int color)))

 (defn box
-  ([size] (.box *applet* (int size)))
-  ([w h d] (.box *applet* (float w) (float h) (float d))))
-
-(defn brightness [what] (.brightness *applet* (int what)))
+  "Creates an extruded rectangle."
+  ([size] (.box *applet* (float size)))
+  ([width height depth] (.box *applet* (float width) (float height) (float depth))))
+
+(defn brightness
+  "Extracts the brightness value from a color. Returns a float."
+  [color]
+  (.brightness *applet* (int color)))

 (defn camera
+  "Sets the position of the camera through setting the eye position, the center
+  of the scene, and which axis is facing upward. Moving the eye position and
+  the direction it is pointing (the center of the scene) allows the images to be
+  seen from different angles. The version without any parameters sets the camera
+  to the default position, pointing to the center of the display window with the
+  Y axis as up. The default values are:
+
+  eyeX:     (/ (width) 2.0)
+  eyeY:     (/ (height) 2.0)
+  eyeZ:     (/ (/ (height) 2.0) (tan (/ (* Math/PI 60.0) 360.0)))
+  centerX:  (/ (width) 2.0)
+  centerY:  (/ (height) 2.0)
+  centerZ:  0
+  upX:      0
+  upY:      1
+  upZ:      0
+
+  Similar imilar to gluLookAt() in OpenGL, but it first clears the current
+  camera settings."
   ([] (.camera *applet*))
   ([eyeX eyeY eyeZ centerX centerY centerZ upX upY upZ]
      (.camera *applet* (float eyeX) (float eyeY) (float eyeZ)
@@ -343,7 +423,11 @@

 (defn can-draw? [] (.canDraw *applet*))

-(defn ceil [n] (PApplet/ceil (float n)))
+(defn ceil
+  "Calculates the closest int value that is greater than or equal to the value
+  of the parameter. For example, (ceil 9.03) returns the value 10."
+  [n]
+  (PApplet/ceil (float n)))

 (defn color-float
   ([gray] (.color *applet* (float gray)))


umm, local update would be nice

umm, local update would be nice

--- profiles.clj
+++ profiles.clj
@@ -9,6 +9,6 @@
        (use '[clojure.repl :only (dir-fn)])
        (load-file (str (System/getProperty "user.home") "/.lein/user.clj"))) }
    :dependencies [[table "0.3.2"] [desc "0.1.0"]
-                  [rubydoc "0.2.0"]]
+                  [rubydoc "0.3.0"]]
  }
 }


Add special sanitizer for right arrows

Add special sanitizer for right arrows

--- doclet/src/clojure/play_clj_doclet/html.clj
+++ doclet/src/clojure/play_clj_doclet/html.clj
@@ -7,6 +7,7 @@
   [s]
   (-> s
       (string/replace "?" "_q")
+      (string/replace "->" "_")
       (string/replace ">" "_r")
       (string/replace "<" "_l")
       (str ".html")))


Document spawn-module

Document spawn-module

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -742,11 +742,20 @@
                    options variables types shape)))

 (defn spawn-module
-  "TODO
+  "Send the named module to the server to be run asynchronously, as a
+  request to the database connection defined by the given session.
+
+  Options passed must be in `valid-request-options` and conform to
+  `request-options`.
+
+  Variables may be passed as a map of Strings or with String names
+  corresponding to maps describing the variable using mandatory key
+  `:value` and optional keys `:namespace` and `:type`.`
+
   See https://docs.marklogic.com/javadoc/xcc/com/marklogic/xcc/ModuleSpawn.html"
   ([session module]
    (spawn-module session module {}))
-  ;; FIXME finish
+  ;; FIXME test
   ;; NB, no response handling b/c asynchonous
   ([session module {:keys [options variables]}]
    (submit-request (.newModuleSpawn session module) session module


fade info tooltips

fade info tooltips

--- cljs-cheatsheet/cljs_cheatsheet/tooltips.cljs
+++ cljs-cheatsheet/cljs_cheatsheet/tooltips.cljs
@@ -2,7 +2,7 @@
   (:require
     [clojure.string :refer [blank? replace split]]
     [clojure.walk :refer [keywordize-keys]]
-    [cljs-cheatsheet.dom :refer [by-id hide-el! set-html! show-el!]]
+    [cljs-cheatsheet.dom :refer [by-id set-html!]]
     [cljs-cheatsheet.html :refer [symbol-tooltip-inner]]
     [cljs-cheatsheet.util :refer [half js-log log uuid]]))

@@ -18,6 +18,9 @@
 (def symbol-link-sel ".fn-a8476, .inside-fn-c7607")
 (def symbol-tooltip-id "symbolTooltip")
 (def symbol-tooltip-sel (str "#" symbol-tooltip-id))
+
+(def fade-in-speed 150)
+(def fade-out-speed 100)

 ;;------------------------------------------------------------------------------
 ;; Helper
@@ -133,10 +136,11 @@
                    :y2 (+ tooltip-top tooltip-height)}}))

 (defn- show-info-tooltip! [tooltip-id]
-  (show-el! tooltip-id))
+  (let [$tooltip-el ($ (str "#" tooltip-id))]
+    (.fadeIn $tooltip-el fade-in-speed)))

 (defn- hide-all-info-tooltips! []
-  (.hide ($ info-tooltip-sel)))
+  (.fadeOut ($ info-tooltip-sel) fade-out-speed))

 ;;------------------------------------------------------------------------------
 ;; Tooltip Atoms
@@ -154,16 +158,16 @@
 (def mouse (atom nil))

 (defn- on-change-mouse [_ _ _ m-pos]
-  ;; close info tooltips
+  ;; close info tooltip
   (when (and @info-tooltip
              (not (mouse-inside-tooltip? m-pos (vals @info-tooltip))))
-    (hide-all-info-tooltips!)
+    (.fadeOut ($ (str "#" (:tooltip-id @info-tooltip))) fade-out-speed)
     (reset! info-tooltip nil))

   ;; close symbol tooltips
   (when (and @symbol-tooltip
              (not (mouse-inside-tooltip? m-pos (vals @symbol-tooltip))))
-    (.fadeOut ($ symbol-tooltip-sel) 100)
+    (.fadeOut ($ symbol-tooltip-sel) fade-out-speed)
     (reset! symbol-tooltip nil)))

 (add-watch mouse :change on-change-mouse)
@@ -215,7 +219,7 @@
                (not tooltip-currently-active?))
       (set-html! symbol-tooltip-id (symbol-tooltip-inner tooltip-data))
       (reset! symbol-tooltip (position-symbol-tooltip! $link-el))
-      (.fadeIn ($ symbol-tooltip-sel) 150))))
+      (.fadeIn ($ symbol-tooltip-sel) fade-in-speed))))

 (defn- touchend-body [js-evt]
   (hide-all-info-tooltips!))


Output errors with causes

Output errors with causes

--- src/yada/body.clj
+++ src/yada/body.clj
@@ -266,16 +266,14 @@
     ;; Only
     (when *output-errors*
       [:div
-       [:p (.getMessage error)]
        (when *output-stack-traces*
-         [:pre
-          (h (with-out-str (pprint error)))])])
-
-    (when-let [path (:journal-browser-path options)]
-      [:div
-       [:p "Details"]
-       [:a {:href (str path (journal/path-for :entry :id id))} id]])
-
+         (let [baos (new java.io.ByteArrayOutputStream)
+               pw (new java.io.PrintWriter (new java.io.OutputStreamWriter baos))]
+           (.printStackTrace error pw)
+           (.flush pw)
+           (let [s (String. (.toByteArray baos))]
+             [:pre s])))])
+
     [:hr]
     [:div
      [:p "yada"]]]))


CMR-5166: Fixed typo.

CMR-5166: Fixed typo.

--- system-int-test/test/cmr/system_int_test/search/granule_retrieval_test.clj
+++ system-int-test/test/cmr/system_int_test/search/granule_retrieval_test.clj
@@ -141,7 +141,7 @@
                response-format))
         (is (= (:metadata umm-g-gran) (:body response)))))

-    (testing "retrieve ECHO10 granule in UMM JSON format"
+    (testing "retrieve ISO SMAP granule in UMM JSON format"
       (let [response (search/retrieve-concept
                       smap-gran-concept-id
                       smap-gran-revision-id


change resolving service

change resolving service

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -9,7 +9,7 @@
   {:coreos {:units [{:name "etcd.service" :command "stop" :mask true}
                     {:name "update-engine.service" :command "stop" :mask true}
                     {:name "locksmithd.service" :command "stop" :mask true}
-                    {:name "systemd-resolved.service" :command "stop"}
+                    {:name "systemd-resolved.service" :command "restart"}
                     {:name "systemd-journald.service" :command "restart"}
                     {:name "docker.service" :command "restart" :enable true}
                     {:name "dcos-link-env.service" :command "start" :content (snippet "systemd/dcos-link-env.service")}
@@ -20,7 +20,8 @@
                     {:name "docker-cleanup.timer" :command "start" :content (snippet "systemd/docker-cleanup.timer")}
                     {:name "install-confd.service" :command "start" :content (snippet "systemd/install-confd.service")}
                     {:name "confd.service" :command "start" :content (snippet "systemd/confd.service") :enable true}
-                    {:name "install-awscli.service" :command "start" :content (snippet "systemd/install-awscli.service") :enable true}]
+                    {:name "install-awscli.service" :command "start" :content (snippet "systemd/install-awscli.service") :enable true}
+                    {:name "dcos-gen-resolvconf.timer" :command "stop" :mask true}]
             :update {:reboot-strategy "off"}}
    :write_files [{:path "/etc/mesosphere/setup-packages/dcos-provider-aws--setup/pkginfo.json"
                   :content "{}\n"}


Refactor clojure code

Refactor clojure code

--- solutions/uri/1013/1013.clj
+++ solutions/uri/1013/1013.clj
@@ -4,19 +4,17 @@
 (defn main []
   (loop [line (read-line)]
     (when line
-      (let [[a b c] (str/split line #" ")
-            a' (Integer/parseInt a)
-            b' (Integer/parseInt b)
-            c' (Integer/parseInt c)
-            result (-> (- a' b')
+      (let [[a b c] (->> (str/split line #" ")
+                         (map #(Integer/parseInt %)))
+            result (-> (- a b)
                        (Math/abs)
-                       (+  b')
-                       (+  a')
+                       (+  b)
+                       (+  a)
                        (/  2))
-            result (-> (- c' result)
+            result (-> (- c result)
                        (Math/abs)
                        (+  result)
-                       (+  c')
+                       (+  c)
                        (/  2))]
         (printf "%d eh o maior%n" result))
       (recur (read-line)))))


Fix reflection warnings

Fix reflection warnings

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -438,13 +438,12 @@
     [0 0])
   ;; characters is a list of {:c \character :x col :y row :fg [r g b] :bg [r g b]}
   (put-chars! [_ layer-id characters]
-    ; TODO: make better precondition check
-    {:pre [#_(contains? (set layer-order) layer-id)
+    {:pre [(get layer-id->group layer-id)
            (get layer-character-map layer-id)]}
     #_(log/info "characters" (str characters))
     (let [columns (-> layer-id layer-id->group :columns)
           rows    (-> layer-id layer-id->group :rows)]
-      (log/info "writing to layer" layer-id "dim:" columns "x" rows)
+      ;(log/info "writing to layer" layer-id "dim:" columns "x" rows)
       (alter (get layer-character-map layer-id)
              (fn [cm]
                (reduce (fn [cm [row row-characters]]
@@ -563,8 +562,8 @@
                 :let [^ByteBuffer glyph-image-data glyph-image-data
                       ^ByteBuffer fg-image-data fg-image-data
                       ^ByteBuffer bg-image-data bg-image-data
-                      texture-columns (zutil/next-pow-2 columns)
-                      texture-rows    (zutil/next-pow-2 rows)
+                      texture-columns (int (zutil/next-pow-2 columns))
+                      texture-rows    (int (zutil/next-pow-2 rows))
                       layer-count     (count layers)
                       layer-size      (* 4 texture-columns texture-rows)]]
           ;; Update glyph texture in buffers
@@ -684,7 +683,6 @@
             (GL20/glUniform1i u-glyphs 1)
             (GL20/glUniform1i u-fg 2)
             (GL20/glUniform1i u-bg 3)
-            ;; TODO: use real value
             (GL20/glUniform1i u-num-layers layer-count)
             (except-gl-errors "uniformli bind")
             (GL20/glUniform2f font-size, character-width character-height)
@@ -765,8 +763,7 @@
     (doseq [[id character-map] layer-character-map]
       (ref-set character-map (get layer-character-map-cleared id))))
   (clear! [_ layer-id]
-    ; TODO: make better precondition check
-    ;{:pre [(contains? (set layer-order) layer-id)]}
+    {:pre [(get layer-id->group layer-id)]}
     (ref-set (get layer-character-map layer-id) (get layer-character-map-cleared layer-id)))
   (fullscreen! [_ v]
     (with-gl-context gl-lock window capabilities
@@ -806,25 +803,21 @@
   (set-fx-fg! [_ layer-id x y fg]
     {:pre [(vector? fg)
            (= (count fg) 3)
-           ; TODO: make better precondition check
-           #_(contains? (set layer-order) layer-id)]}
+           (get layer-id->group layer-id)]}
       (alter (get layer-character-map layer-id)
              (fn [cm] (assoc-in cm [y x :fx-fg-color] fg))))
   (set-fx-bg! [_ layer-id x y bg]
     {:pre [(vector? bg)
            (= (count bg) 3)
-           ; TODO: make better precondition check
-           #_(contains? (set layer-order) layer-id)]}
+           (get layer-id->group layer-id)]}
       (alter (get layer-character-map layer-id)
              (fn [cm] (assoc-in cm [y x :fx-bg-color] bg))))
   (set-fx-char! [_ layer-id x y c]
-    ; TODO: make better precondition check
-    ;{:pre [(contains? (set layer-order) layer-id)]}
+    {:pre [(get layer-id->group layer-id)]}
     (alter (get layer-character-map layer-id)
            (fn [cm] (assoc-in cm [y x :fx-character] c))))
   (clear-fx! [_ layer-id]
-    ; TODO: make better precondition check
-    ;{:pre [(contains? (set layer-order) layer-id)]}
+    {:pre [(get layer-id->group layer-id)]}
     (alter (get layer-character-map layer-id)
            (fn [cm]
              (mapv (fn [line]
@@ -958,11 +951,6 @@

           ;; create width*height texture that gets updated each frame that determines which character to draw in each cell
           _ (log/info "Creating glyph array")
-          ;next-pow-2-columns (zutil/next-pow-2 columns)
-          ;next-pow-2-rows    (zutil/next-pow-2 rows)
-          ;glyph-texture-width  next-pow-2-columns
-          ;glyph-texture-height next-pow-2-rows
-          ;glyph-array    (ta/unsigned-int8 (repeat (* columns rows) 0))
           glyph-image-data (for [layer-group layer-groups]
                              (let [np2-columns (zutil/next-pow-2 (get layer-group :columns))
                                    np2-rows    (zutil/next-pow-2 (get layer-group :rows))]


Update spacing in classifier.clj to be less generous.

--- configs/classifier/classifier.clj
+++ configs/classifier/classifier.clj
@@ -11,8 +11,6 @@

   :main puppetlabs.trapperkeeper.main

-  :ezbake { :user "classifier"
-            :group "classifier"
-            :build-type "foss"
-            }
-  )
+  :ezbake {:user "classifier"
+           :group "classifier"
+           :build-type "foss"})


Fix parentness

Fix parentness

--- src/clj/hatnik/web/server/renderer.clj
+++ src/clj/hatnik/web/server/renderer.clj
@@ -5,7 +5,7 @@
   (hc/html
    [:head
     [:title "Hatnik"]
-    [:link {:rel "stylesheet" :href "/css/bootstrap.min.css"}]]]))
+    [:link {:rel "stylesheet" :href "/css/bootstrap.min.css"}]]))

 (defn page-header []
@@ -57,6 +57,8 @@
       [:div.modal-footer
         [:button.btn.btn-primary {:onClick "hatnik.web.client.z_actions.send_new_project_request()"} "Create"]]]]]

+
+
     [:script {:src "/js/jquery-2.1.1.min.js"}]
     [:script {:src "/js/bootstrap.min.js"}]
     [:script {:src "http://fb.me/react-0.11.1.js"}]


Clean up code

Clean up code

--- src/clj_simple_chart/ncs/discovery.clj
+++ src/clj_simple_chart/ncs/discovery.clj
@@ -16,42 +16,29 @@
 (def columns (:columns raw))
 (def data (:data raw))

-(test/is (= [:dscName
-             :cmpLongName
-             :dscCurrentActivityStatus
-             :dscHcType
-             :wlbName
-             :nmaName
-             :fldName
-             :dscDateFromInclInField
-             :dscDiscoveryYear
-             :dscResInclInDiscoveryName
-             :dscOwnerKind
-             :dscOwnerName
-             :dscNpdidDiscovery
-             :fldNpdidField
-             :wlbNpdidWellbore
-             :dscFactPageUrl
-             :dscFactMapUrl
-             :dscDateUpdated
-             :dscDateUpdatedMax
+(test/is (= [:dscName :cmpLongName :dscCurrentActivityStatus :dscHcType
+             :wlbName :nmaName :fldName :dscDateFromInclInField
+             :dscDiscoveryYear :dscResInclInDiscoveryName :dscOwnerKind
+             :dscOwnerName :dscNpdidDiscovery :fldNpdidField :wlbNpdidWellbore
+             :dscFactPageUrl :dscFactMapUrl :dscDateUpdated :dscDateUpdatedMax
              :DatesyncNPD]
             columns))

-(test/is (= (vec (sort ["Approved for production"
-                        "Decided for production"
-                        "Included in other discovery"
-                        "Producing"
-                        "Production in clarification phase"
-                        "Production is unlikely"
-                        "Production likely, but unclarified"
-                        "Production not evaluated"
-                        "Shut down"]))
-            (->> data
-                 (map :dscCurrentActivityStatus)
-                 (sort)
-                 (distinct)
-                 (vec))))
+(def valid-activity-types (vec (sort ["Approved for production"
+                                      "Decided for production"
+                                      "Included in other discovery"
+                                      "Producing"
+                                      "Production in clarification phase"
+                                      "Production is unlikely"
+                                      "Production likely, but unclarified"
+                                      "Production not evaluated"
+                                      "Shut down"])))
+
+(test/is (every?
+           (fn [item] (some #{item} valid-activity-types))
+           (->> data
+                (map :dscCurrentActivityStatus)
+                (vec))))

 (def status-map {"Approved for production"            :pdo-approved
                  "Decided for production"             :decided-for-production
@@ -168,8 +155,8 @@

 (defn explode-row [row]
   (reduce (fn [o k]
-            (conj o {:year (:year row)
-                     :c k
+            (conj o {:year  (:year row)
+                     :c     k
                      :value (get row k)}))
           [] number-columns))


Fix cache unbinding failure due to late binding

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -104,6 +104,7 @@
                            (take (inc over-limit))
                            (map key))]
              (unbind! data (conj path id))))
+         (swap! data assoc-in child-path {})
          (bind! data child-path
                 (id->fbref id)
                 story-binder))))))


translate terms

translate terms

--- src/cljs/salava/admin/ui/userlist.cljs
+++ src/cljs/salava/admin/ui/userlist.cljs
@@ -135,7 +135,8 @@
           (email-item i)))]
      [:td
       [:div
-       terms]
+       (if terms
+         (t (keyword (str "social/"terms))) nil)]
       ]
      [:td
       (admintool-admin-page id "user" state fetch-users)


Add shortcut to new file button

Add shortcut to new file button

--- src/clojure/nightcode/file_browser.clj
+++ src/clojure/nightcode/file_browser.clj
@@ -2,6 +2,7 @@
   (:require [clojure.java.io :as io]
             [nightcode.dialogs :as dialogs]
             [nightcode.lein :as lein]
+            [nightcode.shortcuts :as shortcuts]
             [nightcode.ui :as ui]
             [nightcode.utils :as utils]
             [seesaw.core :as s]
@@ -59,8 +60,10 @@

 (defn create-card
   []
-  (s/border-panel :north (ui/wrap-panel :items (create-widgets))
-                  :center (s/scrollable (ui/wrap-panel :id :files))))
+  (doto (s/border-panel :north (ui/wrap-panel :items (create-widgets))
+                        :center (s/scrollable (ui/wrap-panel :id :files)))
+    shortcuts/create-hints!
+    (shortcuts/create-mappings! {:new-file new-file!})))

 (defn update-card!
   []


partial merge

partial merge

--- damp.ekeko.aspectj.plugin/src/damp/ekeko/aspectj/assumptions.clj
+++ damp.ekeko.aspectj.plugin/src/damp/ekeko/aspectj/assumptions.clj
@@ -308,21 +308,16 @@
 ;     [(type-name ?type ?name)]
 ;     [(type-type|pattern ?type ?name)]))

-(defn missing|required-requires
-  [?name ?requires]
+(defn missing|required-requires [?name ?requirer]
   (l/fresh [?reqds ?required]
-           (requiring|type-key-val ?requires "type" ?reqds)
-           (contains ?reqds ?name)
-           (fails (type-type|pattern ?required ?name))
-           ))
-
-(defn present|excluded-excluder
-  [?exd ?excluder]
+         (requiring|type-key-val ?requirer "type" ?reqds)
+         (contains ?reqds ?name)
+         (fails (type-type|pattern ?required ?name))))
+(defn present|excluded-excluder [?exd ?excluder]
   (l/fresh [?exds ?excluded]
-           (excluding|type-key-val ?excluder "type" ?exds)
-           (contains ?exds ?exd)
-           (type-type|pattern ?excluded ?exd )
-           ))
+         (excluding|type-key-val ?excluder "type" ?exds)
+         (contains ?exds ?exd)
+         (type-type|pattern ?excluded ?exd )))

 ;this might be slow for many typepatterns as the JVM does not support tail call optimiziation and we cannot use Clojure's recur keyword
@@ -344,21 +339,15 @@
                                  (typepatterns-typepatterns|matched ?tail ?newsofar ?matched)]
                                 [(typepatterns-typepatterns|matched ?tail ?sofar ?matched)]))])))

-(defn
-  typepatterns-matches
-  ([?typepatterns ?matches]
-    (l/all
-      (v+ ?typepatterns)
-      (typepatterns-matches ?typepatterns [] ?matches)))
-  ([?typepatterns ?sofar ?matches]
-    (l/conda [(succeeds (empty? ?typepatterns))
-              (equals ?sofar (into [] (into #{} ?matches)))]
-             [(l/fresh [?head ?tail ?match ?newsofar ?additional]
-                       (equals ?head (first ?typepatterns))
-                       (equals ?tail (rest ?typepatterns))
-                       (findall ?match (type-type|pattern ?match ?head) ?additional)
-                       (equals ?newsofar (concat ?sofar ?additional))
-                       (typepatterns-typepatterns|matched ?tail ?newsofar ?matches))])))
+(defn- get-all-matches
+  [pattern]
+  (ekeko [?t] (type-type|pattern2 ?t pattern)))
+
+(defn- typepatterns-matches
+  [?pattern ?matches]
+  (l/all
+    (v+ ?pattern)
+    (equals ?matches (get-all-matches ?pattern))))

 (defn
   oneOfViolation


New error message for factorize-context

New error message for factorize-context

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

--- src/conexp/contrib/factor_analysis.clj
+++ src/conexp/contrib/factor_analysis.clj
@@ -170,7 +170,8 @@
                        V 0,
                        [j a value] (find-maximal U D)]
                   (when (zero? value)
-                    (illegal-state "0 value"))
+                    (illegal-state "Could not find next attribute (0 value). "
+                                   "Make sure that no floating point inaccuracies occured."))
                   (if (> value V)
                     (recur (fuzzy-object-derivation context
                                                     (fuzzy-attribute-derivation context (assoc D j a)))


Update src/active/clojure/validation.cljc

Co-authored-by: kaaninho <f950d10c4916556a5d4bff6a6dc331bacbf26608@active-group.de>

--- src/active/clojure/validation.cljc
+++ src/active/clojure/validation.cljc
@@ -101,7 +101,7 @@
   [^{:doc "The candidate value that was being validated."}
    candidate validation-error-candidate
    ^{:doc "A message signifying what kind of error occured.  It should
-possible for the user to interpret the message as they please, so
+be possible for the user to interpret the message as they please, so
 usually a namespaced keyword representing the error works well."}
    message validation-error-message
    ^{:doc "Arbitrary data that can be added to an error."}


Remove extraneous use of list

Remove extraneous use of list

--- src-cljs/frontend/components/project/common.cljs
+++ src-cljs/frontend/components/project/common.cljs
@@ -53,10 +53,10 @@
         (html
           [:div.alert {:class "warning alert-warning"}
            [:i.material-icons.alert-icon.warning "warning"]
-           (list (gstring/format "This project is covered by %s's trial of %s containers which expires in %s. "
-                                 plan-org-name (plan-model/trial-containers plan) (pluralize days "day"))
-                 [:a.pay-now-plain-text {:href plan-path} "Update your plan"]
-                 " before the trial expires to continue using these containers.")
+           (gstring/format "This project is covered by %s's trial of %s containers which expires in %s. "
+                                plan-org-name (plan-model/trial-containers plan) (pluralize days "day"))
+           [:a.pay-now-plain-text {:href plan-path} "Update your plan"]
+           " before the trial expires to continue using these containers."
            [:a.dismiss {:on-click #(raise! owner [:dismiss-trial-update-banner])}
             [:i.material-icons "clear"]]])))))


don't use a :titled attribute; leave :title nil if not explicitly set

--- src/app/cljs/one/sample/model.cljs
+++ src/app/cljs/one/sample/model.cljs
@@ -35,8 +35,7 @@
         now     #(.getTime (js/Date.))
         init    (swap! state assoc :who who :id (or id (uuid))
                        :content (or content "") :ts (now)
-                       :titled (if title true false)
-                       :title (or title "<Untitled>"))]
+                       :title (or title nil))]
     (fn document [command & args]
       (condp = command
         :set! (let [[k v] args]


s/warn/debug/

s/warn/debug/

--- src/babel/francais/morphology.cljc
+++ src/babel/francais/morphology.cljc
@@ -55,7 +55,7 @@
                  regular-patterns))]
     (if (not (empty? retval))
       (log/debug (str "analyze '" surface-form "': count=" (count retval) ";" (string/join "," (map strip-refs retval))))
-      (log/warn (str " analyze: could not analyze surface-form: " surface-form)))
+      (log/debug (str " analyze: could not analyze surface-form: " surface-form)))
     retval))

 (defn lookup-in [lexicon {spec :spec}]


[#30] Removed duplicate docstring

[#30] Removed duplicate docstring

Thanks to Eastwood!

--- backend/src/org/akvo/dash/endpoint/util.clj
+++ backend/src/org/akvo/dash/endpoint/util.clj
@@ -8,8 +8,6 @@

 ;; Deprecated
 (defn render [v]
-  "Takes a "
-  "Takes a function that will generate a response."
   (try
     {:status  200
      :headers {"Content-Type" "application/json"}


don't use recursive walk to stringify-keys

--- src/clj/backtype/storm/clojure.clj
+++ src/clj/backtype/storm/clojure.clj
@@ -1,7 +1,6 @@
 (ns backtype.storm.clojure
   (:use [clojure.contrib.def :only [defnk defalias]])
   (:use [backtype.storm bootstrap util])
-  (:use [clojure walk])
   (:import [backtype.storm StormSubmitter])
   (:import [backtype.storm.generated StreamInfo])
   (:import [backtype.storm.tuple Tuple])
@@ -161,7 +160,10 @@
   [^OutputCollector collector stream values]
   (if (map? values)
     (let [ fields (.. collector getContext (getThisOutputFields stream) toList) ]
-      (vec (map (stringify-keys values) fields)))
+      (vec (map (into
+                  (empty values) (for [[k v] values]
+                                   [(if (keyword? k) (name k) k) v]))
+                fields)))
     values))

 (defnk emit-bolt! [^OutputCollector collector values


Implement Deva icebreakers

Implement Deva icebreakers

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -110,9 +110,36 @@
   (cloud-icebreaker (auto-icebreaker [type] {:abilities [(break-sub 2 0 (lower-case type))
                                                          (strength-pump 2 3)]})))

+(defn- deva
+  "Deva breakers"
+  [name]
+  (auto-icebreaker ["All"]
+                   {:abilities [(break-sub 1 1 "ice")
+                                (strength-pump 1 1)
+                                {:req (req (seq (filter #(has-subtype? % "Deva") (:hand runner))))
+                                 :label "Swap with a deva program from your Grip" :cost [:credit 2]
+                                 :prompt (str "Choose a deva program in your Grip to swap with " name)
+                                 :choices {:req #(and in-hand? (has-subtype? % "Deva"))}
+                                 :msg (msg "swap in " (:title target) " from their Grip")
+                                 :effect (req (if-let [hostcard (:host card)]
+                                                (let [hosted (host state side (get-card state hostcard) target)]
+                                                  (card-init state side hosted false))
+                                                (let [devavec (get-in @state [:runner :rig :program])
+                                                      devaindex (first (keep-indexed #(when (= (:cid %2) (:cid card)) %1) devavec))
+                                                      newdeva (assoc target :zone (:zone card) :installed true)
+                                                      newvec (apply conj (subvec devavec 0 devaindex) newdeva (subvec devavec devaindex))]
+                                                  (lose state :runner :memory (:memoryunits card))
+                                                  (swap! state assoc-in [:runner :rig :program] newvec)
+                                                  (swap! state update-in [:runner :hand] (fn [coll] (remove-once #(not= (:cid %) (:cid target)) coll)))
+                                                  (card-init state side newdeva false)))
+                                              (move state side card :hand))}]}))
+
 ;;; Icebreaker definitions
 (def cards-icebreakers
-  {"Alpha"
+  {"Aghora"
+   (deva "Aghora")
+
+   "Alpha"
    (auto-icebreaker ["All"]
                     {:abilities [{:cost [:credit 1]
                                   :req (req (= (:position run) (count (:ices run))))
@@ -382,6 +409,8 @@
    (auto-icebreaker ["Code Gate"]
                     {:abilities [(break-sub 1 1 "code gate")
                                  (strength-pump 1 3)]})
+   "Sadyojata"
+   (deva "Sadyojata")

    "Sage"
    {:abilities [{:cost [:credit 2] :req (req (or (has-subtype? current-ice "Barrier")
@@ -428,6 +457,9 @@
    (auto-icebreaker ["Code Gate"]
                     {:abilities [(break-sub 1 1 "code gate")
                                  (strength-pump 1 1)]})
+
+   "Vamadeva"
+   (deva "Vamadeva")

    "Wyrm"
    {:abilities [{:cost [:credit 3] :msg "break 1 subroutine on ICE with 0 or less strength"}


adjust circle size and link distance

adjust circle size and link distance

--- src/cljs/ceres_analytics/core.cljs
+++ src/cljs/ceres_analytics/core.cljs
@@ -53,7 +53,7 @@
                          (call (.-drag force)))]
       (.. node-enter
           (append "svg:circle")
-          (attr {:class "node-stroke" :r 3})
+          (attr {:class "node-stroke" :r 5})
           (style {:fill (fn [d] (color (dec (:group d))))
                   :stroke "#fff"}))
       (.. node-enter (append "title") (text (fn [d] (:value d)))))
@@ -74,7 +74,7 @@
     (.. force
         (charge -550)
         (gravity 0.5)
-        (linkDistance 7)
+        (linkDistance 15)
         (friction 0.1)
         (size [width height])
         (nodes (:nodes data))
@@ -146,7 +146,7 @@
   (go
     (let [{:keys [ws-channel error]} (<! (ws-ch "ws://localhost:8091/data/ws"))]
       (swap! state assoc-in [:ws-channel] ws-channel)
-      (>! ws-channel {:topic :user-tree :data 2834511})
+      (>! ws-channel {:topic :user-tree :data 5734902})
       (if-not error
         (loop [{:keys [message error] :as in} (<! ws-channel)]
           (when in


CLJS-1114: browser REPL script loading race condition

the browser REPL cannot use document.write to load scripts after
page load as that would blow away the document.

However appending script element to document.body suffers from
race conditions due to asynchronous script loading when not
using document.write.

Add a load queue which enforces sequential load order.

--- src/cljs/clojure/browser/repl.cljs
+++ src/cljs/clojure/browser/repl.cljs
@@ -109,6 +109,8 @@
       (js/setTimeout #(send-result connection url (wrap-message :ready "ready")) 50))
     (js/alert "No 'xpc' param provided to child iframe.")))

+(def load-queue nil)
+
 (defn connect
   "Connects to a REPL server from an HTML document. After the
   connection is made, the REPL will evaluate forms in the context of
@@ -135,14 +137,28 @@
       (set! (.-require__ js/goog) js/goog.require)
       ;; suppress useless Google Closure error about duplicate provides
       (set! (.-isProvided_ js/goog) (fn [name] false))
-      (set! (.-writeScriptTag_ js/goog)
+      (set! (.-writeScriptTag__ js/goog)
         (fn [src opt_sourceText]
           (.appendChild js/document.body
             (as-> (.createElement js/document "script") script
-              (doto script (aset "type" "text/javascript"))
+              (doto script
+                (aset "type" "text/javascript")
+                (aset "onload"
+                  (fn []
+                    (when load-queue
+                      (if (zero? (alength load-queue))
+                        (set! load-queue nil)
+                        (.apply js/goog.writeScriptTag__ nil (.shift load-queue)))))))
               (if (nil? opt_sourceText)
                 (doto script (aset "src" src))
                 (doto script (gdom/setTextContext opt_sourceText)))))))
+      (set! (.-writeScriptTag_ js/goog)
+        (fn [src opt_sourceText]
+          (if load-queue
+            (.push load-queue #js [src opt_sourceText])
+            (do
+              (set! load-queue #js [])
+              (js/goog.writeScriptTag__ src opt_sourceText)))))
       (set! (.-require js/goog)
         (fn [src reload]
           (when (= reload "reload-all")


Fix broken submit bug on add example

Fix broken submit bug on add example

--- src/cljs/clojuredocs/examples.cljs
+++ src/cljs/clojuredocs/examples.cljs
@@ -55,7 +55,7 @@
    [:h5 "New Example"]
    [:div.add-example-preview
     [:div.live-preview {:ref "live-preview"}]]
-   [:div.form
+   [:form
     {:on-submit #(validate-and-submit
                    owner
                    {:text text
@@ -183,5 +183,4 @@
          (if user
            (om/build $add app)
            [:div.login-required-message
-            [:a {:href "#" #_(common/gh-auth-url uri)} "Log in"]
-            " to add an example"])]))))
+            "Log in to add an example"])]))))


add convenience macro

add convenience macro

--- src/clojure/zensols/model/weka.clj
+++ src/clojure/zensols/model/weka.clj
@@ -3,7 +3,7 @@
 and [[zensols.model.execute-classifier]]."
       :author "Paul Landes"}
     zensols.model.weka
-  (:use [clojure.pprint :only [pprint]])
+  (:import [com.zensols.weka IFnClassifier])
   (:require [clojure.tools.logging :as log]
             [clojure.string :as str])
   (:import (weka.core Attribute Instance Instances FastVector))
@@ -451,3 +451,37 @@
     (.setAttributeIndicesArray remove-filter (into-array Integer/TYPE indexes))
     (.setInputFormat remove-filter inst)
     (Filter/useFilter inst remove-filter)))
+
+(defmacro let-classifier
+  "fnspec ==> (classifier-name [insts] exprs)
+
+  Define a classifier that uses Clojure code to evaluate **insts** instances
+  and evaluate body **exprs**.
+
+  Example:
+```
+(let-classifier
+    (langid-baseline [inst]
+       (let [attrib (weka/attribute-by-name inst \"langid-1-id\")
+             val (.stringValue inst attrib)
+             rval (= \"en\" val)]
+         (log/infof \"langid: %s for: %s: res: %s\" val inst rval)
+         (if rval 1 0)))
+  (terse-results lang-baseline meta-set))
+```"
+  {:style/indent 1
+   :forms '[(let-classifier fnspecs* exprs*)]
+   :special-form true}
+  [fdef-expr & forms]
+  (let [sym- (first fdef-expr)
+        fdef- (rest fdef-expr)]
+    `(let [ns-sym# (gensym)]
+       (try
+         (let [ns# (create-ns ns-sym#)
+               fn-sym# (gensym)
+               fn-def# (fn ~@fdef-)]
+           (intern ns# fn-sym# fn-def#)
+           (let [res# (IFnClassifier. (pr-str ns-sym#) (pr-str fn-sym#))
+                 ~sym- res#]
+             ~@forms))
+         (finally (remove-ns ns-sym#))))))


Factored out chain into vars

Factored out chain into vars

--- src/yada/core.clj
+++ src/yada/core.clj
@@ -64,6 +64,350 @@
    (filter (comp (partial = :basic) :type))
    (map :realm)))

+(defn available?
+  "Is the service available?"
+  [ctx]
+  (let [res (service/service-available? (-> ctx :http-resource :service-available?) ctx)]
+    (if-not (service/interpret-service-available res)
+      (d/error-deferred
+       (ex-info "" (merge {:status 503
+                           ::http-response true}
+                          (when-let [retry-after (service/retry-after res)] {:headers {"retry-after" retry-after}}))))
+      ctx)))
+
+(defn known-method?
+  [ctx]
+  (if-not (:method-instance ctx)
+    (d/error-deferred (ex-info "" {:status 501 ::method (:method ctx) ::http-response true}))
+    ctx))
+
+(defn uri-too-long?
+  [ctx]
+  (if (service/request-uri-too-long? (-> ctx :options :request-uri-too-long?) (-> ctx :request :uri))
+    (d/error-deferred (ex-info "" {:status 414 ::http-response true}))
+    ctx))
+
+(defn TRACE
+  [ctx]
+  (if (#{:trace} (:method ctx))
+    (if (false? (-> ctx :options :trace))
+      (d/error-deferred
+       (ex-info "Method Not Allowed"
+                {:status 405 ::http-response true}))
+      (methods/request (:method-instance ctx) ctx))
+    ctx))
+
+(defn method-allowed?
+  "Is method allowed on this resource?"
+  [ctx]
+  (if-not (contains? (-> ctx :allowed-methods) (:method ctx))
+    (d/error-deferred
+     (ex-info "Method Not Allowed"
+              {:status 405
+               :headers {"allow" (str/join ", " (map (comp (memfn toUpperCase) name) (-> ctx :http-resource :allowed-methods)))}
+               ::http-response true}))
+    ctx))
+
+(defn malformed?
+  "Malformed? (parameters)"
+  [ctx]
+  (let [method (:method ctx)
+        request (:request ctx)
+        keywordize (fn [m] (into {} (for [[k v] m] [(keyword k) v])))
+
+        parameters (-> ctx :http-resource :parameters)
+
+        parameters
+        (when parameters
+          {:path
+           (when-let [schema (get-in parameters [method :path])]
+             (rs/coerce schema (:route-params request) :query))
+
+           :query
+           (when-let [schema (get-in parameters [method :query])]
+             ;; We'll call assoc-query-params with the negotiated charset, falling back to UTF-8.
+             ;; Also, read this:
+             ;; http://www.w3.org/TR/html5/forms.html#application/x-www-form-urlencoded-encoding-algorithm
+             (rs/coerce schema (-> request (assoc-query-params (or (:charset ctx) "UTF-8")) :query-params keywordize) :query))
+
+           :body
+           (when-let [schema (get-in parameters [method :body])]
+             (let [body (read-body (-> ctx :request))]
+               (body/coerce-request-body body (req/content-type request) schema)))
+
+           :form
+           ;; TODO: Can we use rep:from-representation
+           ;; instead? It's virtually the same logic for
+           ;; url encoded forms
+           (when-let [schema (get-in parameters [method :form])]
+             (when (req/urlencoded-form? request)
+               (let [fp (keywordize-keys
+                         (ring.util.codec/form-decode (read-body (-> ctx :request))
+                                                      (req/character-encoding request)))]
+                 (rs/coerce schema fp :json))))
+
+           :header
+           (when-let [schema (get-in parameters [method :header])]
+             (let [params (select-keys (-> request :headers keywordize-keys) (keys schema))]
+               (rs/coerce schema params :query)))})]
+
+    (let [errors (filter (comp schema.utils/error? second) parameters)]
+      (if (not-empty errors)
+        (d/error-deferred (ex-info "" {:status 400
+                                       :body errors
+                                       ::http-response true}))
+
+        (if parameters
+          (let [body (:body parameters)
+                merged-params (merge (apply merge (vals (dissoc parameters :body)))
+                                     (when body {:body body}))]
+            (cond-> ctx
+              (not-empty merged-params) (assoc :parameters merged-params)))
+          ctx)))))
+
+(defn authentication
+  "Authentication"
+  [ctx]
+  (cond-> ctx
+    (not-empty (filter (comp (partial = :basic) :type) (-> ctx :http-resource :security)))
+    (assoc :authentication (:basic-authentication (ring.middleware.basic-authentication/basic-authentication-request (:request ctx) (fn [user password] {:user user :password password}))))))
+
+;; Authorization
+(defn authorization
+  "Authorization"
+  [ctx]
+  (if-let [res (service/authorize (-> ctx :http-resource :authorization) ctx)]
+    (if (= res :not-authorized)
+      (d/error-deferred
+       (ex-info ""
+                (merge
+                 {:status 401 ::http-response true}
+                 (when-let [basic-realm (first (sequence realms-xf (-> ctx :http-resource :security)))]
+                   {:headers {"www-authenticate" (format "Basic realm=\"%s\"" basic-realm)}}))
+                ))
+      (if-let [auth (service/authorization res)]
+        (assoc ctx :authorization auth)
+        ctx))
+    (d/error-deferred (ex-info "" {:status 403
+                                   ::http-response true}))))
+
+;; Now we do a fetch, so the resource has a chance to
+;; load any metadata it may need to answer the questions
+;; to follow. It can also load state in this step, if it
+;; wants, but can defer this to the get-state call if it
+;; wants. This would usually depend on the size of the
+;; state. For example, if it's a stream, it would be
+;; returned on get-state.
+
+;; Do the fetch here - this is intended to allow
+;; resources to prepare to answer questions about
+;; themselves. This has to happen _after_ the request
+;; parameters have been established because the fetch
+;; might depend on them in some way. The fetch may
+;; involve a database trip, to load context based on the
+;; request parameters.
+
+;; The fetch can return a deferred result.
+(defn fetch
+  [ctx]
+  (d/chain
+   (p/fetch (:resource ctx) ctx)
+   (fn [res]
+     (assoc ctx :resource res))))
+
+;; Content negotiation
+;; TODO: Unknown Content-Type? (incorporate this into conneg)
+(defn select-representation
+  [ctx]
+  (let [representation
+        (rep/select-representation (:request ctx) (-> ctx :http-resource :representations))]
+
+    (if (nil? representation)
+      (d/error-deferred
+       (ex-info "" {:status 406
+                    ::http-response true}))
+
+      (cond-> ctx
+        representation (assoc-in [:response :representation] representation)
+        (-> ctx :http-resource :vary) (assoc-in [:response :vary] (-> ctx :http-resource :vary))))))
+
+(defn exists?
+  "A current representation for the resource exists?"
+  [ctx]
+  (if (-> ctx :http-resource :existence?)
+    (d/chain
+     (p/exists? (:resource ctx) ctx)
+     (fn [exists?]
+       (assoc ctx :exists? exists?)))
+    ;; Default
+    (assoc ctx :exists? true)))
+
+;; Conditional requests - last modified time
+(defn check-modification-time [ctx]
+  (d/chain
+   (or
+    (p/last-modified (-> ctx :options :last-modified) ctx)
+    (p/last-modified (:resource ctx) ctx))
+
+   (fn [last-modified]
+     (if-let [last-modified (round-seconds-up last-modified)]
+
+       (if-let [if-modified-since (some-> (:request ctx)
+                                          (get-in [:headers "if-modified-since"])
+                                          ring.util.time/parse-date)]
+
+         (if (<=
+              (.getTime last-modified)
+              (.getTime if-modified-since))
+
+           ;; exit with 304
+           (d/error-deferred
+            (ex-info "" (merge {:status 304
+                                ::http-response true}
+                               ctx)))
+
+           (assoc-in ctx [:response :last-modified] (ring.util.time/format-date last-modified)))
+
+         (or
+          (some->> last-modified
+                   ring.util.time/format-date
+                   (assoc-in ctx [:response :last-modified]))
+          ctx))
+       ctx))))
+
+;; Check ETag - we already have the representation details,
+;; which are necessary for a strong validator. See
+;; section 2.3.3 of RFC 7232.
+
+;; If-Match check
+(defn if-match
+  [ctx]
+
+  (if-let [matches (some->> (get-in (:request ctx) [:headers "if-match"])
+                            (parse-csv)
+                            set)]
+
+    ;; We have an If-Match to process
+    (cond
+      (and (contains? matches "*") (-> ctx :http-resource :representations count pos?))
+      ;; No need to compute etag, exit
+      ctx
+
+      ;; Otherwise we need to compute the etag for each current
+      ;; representation of the resource
+
+      ;; Create a map of representation -> etag
+      (-> ctx :http-resource :version?)
+      (let [version (p/version (:resource ctx) ctx)
+            etags (into {} (map (juxt identity (partial p/to-etag version)) (-> ctx :http-resource :representations)))]
+
+        (if (empty? (set/intersection matches (set (vals etags))))
+          (d/error-deferred
+           (ex-info "Precondition failed"
+                    {:status 412
+                     ::http-response true}))
+
+          ;; Otherwise, let's use the etag we've just
+          ;; computed. Note, this might yet be
+          ;; overridden by the (unsafe) method returning
+          ;; a modified response. But if the method
+          ;; chooses not to reset the etag (perhaps the
+          ;; resource state didn't change), then this
+          ;; etag will do for the response.
+          (assoc-in ctx [:response :etag]
+                    (get etags (:representation ctx))))))
+    ctx
+    ))
+
+(defn invoke-method
+  "Methods"
+  [ctx]
+  (methods/request (:method-instance ctx) ctx))
+
+;; Compute ETag, if not already done so
+
+;; Unsafe resources that support etags MUST return a
+;; response which contains a version if they mutate the
+;; resource's state. If they don't return a version, no
+;; etag (or worse, a previously computed etag) will be
+;; set in the response header.
+
+;; Produce ETag: The "ETag" header field in a response provides
+;; the current entity-tag for the selected
+;; representation, as determined at the conclusion of
+;; handling the request. RFC 7232 section 2.3
+
+;; If we have just mutated the resource, we should
+;; recompute the etag
+
+(defn compute-etag
+  [ctx]
+  ;; only if resource supports etags
+  (if (-> ctx :http-resource :version?)
+    ;; only if the resource hasn't already set an etag
+    (when-let [version (or (-> ctx :response :version)
+                           (p/version (:resource ctx) ctx))]
+      (let [etag (p/to-etag version (get-in ctx [:response :representation]))]
+        (assoc-in ctx [:response :etag] etag)))
+    ctx))
+
+;; CORS
+;; TODO: Reinstate
+#_(defn cors [ctx]
+  (if-let [origin (service/allow-origin allow-origin ctx)]
+    (update-in ctx [:response :headers]
+               merge {"access-control-allow-origin"
+                      origin
+                      "access-control-expose-headers"
+                      (apply str
+                             (interpose ", " ["Server" "Date" "Content-Length" "Access-Control-Allow-Origin"]))})
+    ctx))
+
+;; Response
+(defn create-response
+  [ctx]
+  (let [response
+        {:status (or (get-in ctx [:response :status])
+                     (service/status (-> ctx :http-resource :options :status) ctx)
+                     200)
+         :headers (merge
+                   (get-in ctx [:response :headers])
+                   ;; TODO: The context and its response
+                   ;; map must be documented so users are
+                   ;; clear what they can change and the
+                   ;; effect of this change.
+                   (when (not= (:method ctx) :options)
+                     (merge {}
+                            (when-let [x (get-in ctx [:response :representation :media-type])]
+                              (let [y (get-in ctx [:response :representation :charset])]
+                                (if (and y (= (:type x) "text"))
+                                  {"content-type" (mt/media-type->string (assoc-in x [:parameters "charset"] (charset/charset y)))}
+                                  {"content-type" (mt/media-type->string x)})))
+                            (when-let [x (get-in ctx [:response :representation :encoding])]
+                              {"content-encoding" x})
+                            (when-let [x (get-in ctx [:response :representation :language])]
+                              {"content-language" x})
+                            (when-let [x (get-in ctx [:response :last-modified])]
+                              {"last-modified" x})
+                            (when-let [x (get-in ctx [:response :vary])]
+                              (when (not-empty x)
+                                {"vary" (rep/to-vary-header x)}))
+                            (when-let [x (get-in ctx [:response :etag])]
+                              {"etag" x})))
+                   (when-let [x (get-in ctx [:response :content-length])]
+                     {"content-length" x})
+
+                   #_(when true
+                       {"access-control-allow-origin" "*"})
+
+                   ;; TODO: Resources can add headers via their methods
+                   (service/headers (-> ctx :http-resource :options :headers) ctx))
+
+         ;; TODO :status and :headers should be implemented like this in all cases
+         :body (get-in ctx [:response :body])}]
+    (debugf "Returning response: %s" (dissoc response :body))
+    response))
+
 (defn- handle-request [http-resource request]
   (let [ctx (make-context)]
     (let [method (:request-method request)
@@ -78,346 +422,36 @@
           (merge
            {:method method
             :method-instance (get (:known-methods http-resource) method)
+            :http-resource http-resource
             :resource (:resource http-resource)
             :request request
-            :allowed-methods (:allowed-methods http-resource)})
+            :allowed-methods (:allowed-methods http-resource)
+            :options options})

           (d/chain

-           ;; Available?
-           (fn [ctx]
-             (let [res (service/service-available? (:service-available? http-resource) ctx)]
-               (if-not (service/interpret-service-available res)
-                 (d/error-deferred
-                  (ex-info "" (merge {:status 503
-                                      ::http-response true}
-                                     (when-let [retry-after (service/retry-after res)] {:headers {"retry-after" retry-after}}))))
-                 ctx)))
-
-           ;; Known method?
-           (fn [ctx]
-             (if-not (:method-instance ctx)
-               (d/error-deferred (ex-info "" {:status 501 ::method method ::http-response true}))
-               ctx))
-
-           ;; URI too long?
-           (fn [ctx]
-             (if (service/request-uri-too-long? (:request-uri-too-long? options) (:uri request))
-               (d/error-deferred (ex-info "" {:status 414
-                                              ::http-response true}))
-               ctx))
-
-           ;; TRACE
-           (fn [ctx]
-             (if (#{:trace} method)
-               (if (false? (:trace options))
-                 (d/error-deferred (ex-info "Method Not Allowed"
-                                            {:status 405
-                                             ::http-response true}))
-                 (methods/request (:method-instance ctx) ctx))
-               ctx))
-
-           ;; Is method allowed on this resource?
-           (fn [ctx]
-             (if-not (contains? (:allowed-methods http-resource) method)
-               (d/error-deferred
-                (ex-info "Method Not Allowed"
-                         {:status 405
-                          :headers {"allow" (str/join ", " (map (comp (memfn toUpperCase) name) (:allowed-methods http-resource)))}
-                          ::http-response true}))
-               ctx))
-
-           ;; Malformed? (parameters)
-           (fn [ctx]
-             (let [keywordize (fn [m] (into {} (for [[k v] m] [(keyword k) v])))
-
-                   parameters (:parameters http-resource)
-
-                   parameters
-                   (when parameters
-                     {:path
-                      (when-let [schema (get-in parameters [method :path])]
-                        (rs/coerce schema (:route-params request) :query))
-
-                      :query
-                      (when-let [schema (get-in parameters [method :query])]
-                        ;; We'll call assoc-query-params with the negotiated charset, falling back to UTF-8.
-                        ;; Also, read this:
-                        ;; http://www.w3.org/TR/html5/forms.html#application/x-www-form-urlencoded-encoding-algorithm
-                        (rs/coerce schema (-> request (assoc-query-params (or (:charset ctx) "UTF-8")) :query-params keywordize) :query))
-
-                      :body
-                      (when-let [schema (get-in parameters [method :body])]
-                        (let [body (read-body (-> ctx :request))]
-                          (body/coerce-request-body body (req/content-type request) schema)))
-
-                      :form
-                      ;; TODO: Can we use rep:from-representation
-                      ;; instead? It's virtually the same logic for
-                      ;; url encoded forms
-                      (when-let [schema (get-in parameters [method :form])]
-                        (when (req/urlencoded-form? request)
-                          (let [fp (keywordize-keys
-                                    (ring.util.codec/form-decode (read-body (-> ctx :request))
-                                                                 (req/character-encoding request)))]
-                            (rs/coerce schema fp :json))))
-
-                      :header
-                      (when-let [schema (get-in parameters [method :header])]
-                        (let [params (select-keys (-> request :headers keywordize-keys) (keys schema))]
-                          (rs/coerce schema params :query)))})]
-
-               (let [errors (filter (comp schema.utils/error? second) parameters)]
-                 (if (not-empty errors)
-                   (d/error-deferred (ex-info "" {:status 400
-                                                  :body errors
-                                                  ::http-response true}))
-
-                   (if parameters
-                     (let [body (:body parameters)
-                           merged-params (merge (apply merge (vals (dissoc parameters :body)))
-                                                (when body {:body body}))]
-                       (cond-> ctx
-                         (not-empty merged-params) (assoc :parameters merged-params)))
-                     ctx)))))
-
-           ;; Authentication
-           (fn [ctx]
-             (cond-> ctx
-               (not-empty (filter (comp (partial = :basic) :type) (:security http-resource)))
-               (assoc :authentication (:basic-authentication (ring.middleware.basic-authentication/basic-authentication-request request (fn [user password] {:user user :password password}))))))
-
-           ;; Authorization
-           (fn [ctx]
-             (if-let [res (service/authorize (:authorization http-resource) ctx)]
-               (if (= res :not-authorized)
-                 (d/error-deferred
-                  (ex-info ""
-                           (merge
-                            {:status 401 ::http-response true}
-                            (when-let [basic-realm (first (sequence realms-xf (:security http-resource)))]
-                              {:headers {"www-authenticate" (format "Basic realm=\"%s\"" basic-realm)}}))
-                           ))
-                 (if-let [auth (service/authorization res)]
-                   (assoc ctx :authorization auth)
-                   ctx))
-               (d/error-deferred (ex-info "" {:status 403
-                                              ::http-response true}))))
-
-           ;; Now we do a fetch, so the resource has a chance to
-           ;; load any metadata it may need to answer the questions
-           ;; to follow. It can also load state in this step, if it
-           ;; wants, but can defer this to the get-state call if it
-           ;; wants. This would usually depend on the size of the
-           ;; state. For example, if it's a stream, it would be
-           ;; returned on get-state.
-
-           ;; Do the fetch here - this is intended to allow
-           ;; resources to prepare to answer questions about
-           ;; themselves. This has to happen _after_ the request
-           ;; parameters have been established because the fetch
-           ;; might depend on them in some way. The fetch may
-           ;; involve a database trip, to load context based on the
-           ;; request parameters.
-
-           ;; The fetch can return a deferred result.
-           (fn [ctx]
-             (d/chain
-              (p/fetch (:resource http-resource) ctx)
-              (fn [res]
-                (assoc ctx :resource res))))
+           available?
+           known-method?
+           uri-too-long?
+           TRACE
+           method-allowed?
+           malformed?
+           authentication
+           authorization
+           fetch

            ;; TODO: Unknown or unsupported Content-* header

            ;; TODO: Request entity too large - shouldn't we do this later,
            ;; when we determine we actually need to read the request body?

-           ;; Content negotiation
-           ;; TODO: Unknown Content-Type? (incorporate this into conneg)
-           (fn [ctx]
-             (let [representation
-                   (rep/select-representation request (:representations http-resource))]
-
-               (if (nil? representation)
-                 (d/error-deferred (ex-info "" {:status 406
-                                                ::http-response true}))
-
-                 (cond-> ctx
-                   representation (assoc-in [:response :representation] representation)
-                   (:vary http-resource) (assoc-in [:response :vary] (:vary http-resource))
-                   ))))
-
-           ;; A current representation for the resource exists?
-           (fn [ctx]
-             (if (:existence? http-resource)
-               (d/chain
-                (p/exists? (:resource ctx) ctx)
-                (fn [exists?]
-                  (assoc ctx :exists? exists?)))
-               ;; Default
-               (assoc ctx :exists? true)))
-
-           ;; Conditional requests - last modified time
-           (fn [ctx]
-             (d/chain
-              (or
-               (p/last-modified (:last-modified options) ctx)
-               (p/last-modified (:resource ctx) ctx))
-
-              (fn [last-modified]
-                (if-let [last-modified (round-seconds-up last-modified)]
-
-                  (if-let [if-modified-since (some-> request
-                                                     (get-in [:headers "if-modified-since"])
-                                                     ring.util.time/parse-date)]
-
-                    (if (<=
-                         (.getTime last-modified)
-                         (.getTime if-modified-since))
-
-                      ;; exit with 304
-                      (d/error-deferred
-                       (ex-info "" (merge {:status 304
-                                           ::http-response true}
-                                          ctx)))
-
-                      (assoc-in ctx [:response :last-modified] (ring.util.time/format-date last-modified)))
-
-                    (or
-                     (some->> last-modified
-                              ring.util.time/format-date
-                              (assoc-in ctx [:response :last-modified]))
-                     ctx))
-                  ctx))))
-
-           ;; Check ETag - we already have the representation details,
-           ;; which are necessary for a strong validator. See
-           ;; section 2.3.3 of RFC 7232.
-
-           ;; If-Match check
-           (fn [ctx]
-
-             (if-let [matches (some->> (get-in request [:headers "if-match"])
-                                       (parse-csv)
-                                       set)]
-
-               ;; We have an If-Match to process
-               (cond
-                 (and (contains? matches "*") (pos? (count (:representations http-resource))))
-                 ;; No need to compute etag, exit
-                 ctx
-
-                 ;; Otherwise we need to compute the etag for each current
-                 ;; representation of the resource
-
-                 ;; Create a map of representation -> etag
-                 (:version? http-resource)
-                 (let [version (p/version (:resource ctx) ctx)
-                       etags (into {} (map (juxt identity (partial p/to-etag version)) (:representations http-resource)))]
-
-                   (if (empty? (set/intersection matches (set (vals etags))))
-                     (d/error-deferred
-                      (ex-info "Precondition failed"
-                               {:status 412
-                                ::http-response true}))
-
-                     ;; Otherwise, let's use the etag we've just
-                     ;; computed. Note, this might yet be
-                     ;; overridden by the (unsafe) method returning
-                     ;; a modified response. But if the method
-                     ;; chooses not to reset the etag (perhaps the
-                     ;; resource state didn't change), then this
-                     ;; etag will do for the response.
-                     (assoc-in ctx [:response :etag]
-                               (get etags (:representation ctx))))))
-               ctx
-               ))
-
-           ;; Methods
-           (fn [ctx]
-             (methods/request (:method-instance ctx) ctx))
-
-           ;; Compute ETag, if not already done so
-
-           ;; Unsafe resources that support etags MUST return a
-           ;; response which contains a version if they mutate the
-           ;; resource's state. If they don't return a version, no
-           ;; etag (or worse, a previously computed etag) will be
-           ;; set in the response header.
-
-           ;; Produce ETag: The "ETag" header field in a response provides
-           ;; the current entity-tag for the selected
-           ;; representation, as determined at the conclusion of
-           ;; handling the request. RFC 7232 section 2.3
-
-           (fn [ctx]
-             ;; only if resource supports etags
-             (if (:version? http-resource)
-               ;; only if the resource hasn't already set an etag
-               (when-let [version (or (-> ctx :response :version)
-                                      (p/version (:resource ctx) ctx))]
-                 (let [etag (p/to-etag version (get-in ctx [:response :representation]))]
-                   (assoc-in ctx [:response :etag] etag)))
-               ctx))
-
-           ;; If we have just mutated the resource, we should
-           ;; recompute the etag
-
-           ;; CORS
-           ;; TODO: Reinstate
-           #_(fn [ctx]
-               (if-let [origin (service/allow-origin allow-origin ctx)]
-                 (update-in ctx [:response :headers]
-                            merge {"access-control-allow-origin"
-                                   origin
-                                   "access-control-expose-headers"
-                                   (apply str
-                                          (interpose ", " ["Server" "Date" "Content-Length" "Access-Control-Allow-Origin"]))})
-                 ctx))
-
-           ;; Response
-           (fn [ctx]
-             (let [response
-                   {:status (or (get-in ctx [:response :status])
-                                (service/status (-> http-resource :options :status) ctx)
-                                200)
-                    :headers (merge
-                              (get-in ctx [:response :headers])
-                              ;; TODO: The context and its response
-                              ;; map must be documented so users are
-                              ;; clear what they can change and the
-                              ;; effect of this change.
-                              (when (not= method :options)
-                                (merge {}
-                                       (when-let [x (get-in ctx [:response :representation :media-type])]
-                                         (let [y (get-in ctx [:response :representation :charset])]
-                                           (if (and y (= (:type x) "text"))
-                                             {"content-type" (mt/media-type->string (assoc-in x [:parameters "charset"] (charset/charset y)))}
-                                             {"content-type" (mt/media-type->string x)})))
-                                       (when-let [x (get-in ctx [:response :representation :encoding])]
-                                         {"content-encoding" x})
-                                       (when-let [x (get-in ctx [:response :representation :language])]
-                                         {"content-language" x})
-                                       (when-let [x (get-in ctx [:response :last-modified])]
-                                         {"last-modified" x})
-                                       (when-let [x (get-in ctx [:response :vary])]
-                                         (when (not-empty x)
-                                           {"vary" (rep/to-vary-header x)}))
-                                       (when-let [x (get-in ctx [:response :etag])]
-                                         {"etag" x})))
-                              (when-let [x (get-in ctx [:response :content-length])]
-                                {"content-length" x})
-
-                              #_(when true
-                                  {"access-control-allow-origin" "*"})
-
-                              ;; TODO: Resources can add headers via their methods
-                              (service/headers (-> http-resource :options :headers) ctx))
-
-                    ;; TODO :status and :headers should be implemented like this in all cases
-                    :body (get-in ctx [:response :body])}]
-               (debugf "Returning response: %s" (dissoc response :body))
-               response)))
+           select-representation
+           exists?
+           check-modification-time
+           if-match
+           invoke-method
+           compute-etag
+           create-response)

           ;; Handle exits
           (d/catch clojure.lang.ExceptionInfo


Fixing comments from code review.

Fixing comments from code review.

--- src/cmr/metadata_db/api/routes.clj
+++ src/cmr/metadata_db/api/routes.clj
@@ -46,9 +46,7 @@
 (defn- get-concepts
   "Get concepts using concept-id/revision-id tuples."
   [context params concept-id-revisions]
-  (let [allow-missing? (if (and (:allow_missing params) (= "true" (str/lower-case (:allow_missing params))))
-                         true
-                         false)
+  (let [allow-missing? (= "true" (some-> params :allow_missing str/lower-case))
         concepts (concept-service/get-concepts context concept-id-revisions allow-missing?)]
     {:status 200
      :body (to-json concepts params)
@@ -57,11 +55,7 @@
 (defn- get-latest-concepts
   "Get latest version of concepts using a list of concept-ids"
   [context params concept-ids]
-  (println "PARAMS")
-  (println params)
-  (let [allow-missing? (if (and (:allow_missing params) (= "true" (str/lower-case (:allow_missing params))))
-                         true
-                         false)
+  (let [allow-missing? (= "true" (some-> params :allow_missing str/lower-case))
         concepts (concept-service/get-latest-concepts context concept-ids allow-missing?)]
     {:status 200
      :body (to-json concepts params)


Refactor map-db-reader to use arity 2 join on sequences

--- src/com/wsscode/pathom/map_db.cljc
+++ src/com/wsscode/pathom/map_db.cljc
@@ -14,10 +14,9 @@
       ::p/continue)))

 (defn map-db-reader
-  [{:keys    [ast query]
-    ::keys   [refs ident-track]
-    ::p/keys [entity-key]
-    :as      env}]
+  [{:keys  [ast query]
+    ::keys [refs ident-track]
+    :as    env}]
   (let [entity (p/entity env)]
     (if-let [[_ v] (find entity (:key ast))]
       (cond
@@ -31,11 +30,11 @@
         (mapv #(if (p/ident? %)
                  (if (contains? ident-track %)
                    %
-                   (p/join (-> env
-                               (assoc entity-key (get-in refs %)
-                                      ::ident-track (conj (or ident-track #{}) v)
-                                      ::p/union-path (constantly (first %)))
-                               (update ::p/path conj %2))))
+                   (p/join (get-in refs %)
+                     (-> env
+                         (assoc ::ident-track (conj (or ident-track #{}) v)
+                                ::p/union-path (constantly (first %)))
+                         (update ::p/path conj %2))))
                  (p/join % env))
           v (range))


Bump re-com to 1.3.0

Bump re-com to 1.3.0

--- src/leiningen/new/re_frame/project.clj
+++ src/leiningen/new/re_frame/project.clj
@@ -5,7 +5,7 @@
                  [re-frame "0.9.1"]{{#re-frisk?}}
                  [re-frisk "0.3.2"]{{/re-frisk?}}{{#re-com?}}
                  [org.clojure/core.async "0.2.391"]
-                 [re-com "0.8.3"]{{/re-com?}}{{#routes?}}
+                 [re-com "1.3.0"]{{/re-com?}}{{#routes?}}
                  [secretary "1.2.3"]{{/routes?}}{{#garden?}}
                  [garden "1.3.2"]
                  [ns-tracker "0.3.0"]{{/garden?}}{{#handler?}}


figwheel-main: fix regression that fails on missing figwheel-main.edn

--- figwheel-main/src/figwheel/main.cljc
+++ figwheel-main/src/figwheel/main.cljc
@@ -140,7 +140,8 @@
 (defn get-edn-file-key
   ([edn-file key] (get-edn-file-key edn-file key nil))
   ([edn-file key default]
-   (get (read-edn-file edn-file) key default)))
+   (try (get (read-string (slurp edn-file)) key default)
+        (catch Throwable t nil))))

 (def validate-config!*
   (when (try


DJSON-18 Fast way to print indented json

Signed-off-by: Alex Miller <99328387f8334f68433c424d2dfd83062f62754b@cognitect.com>

--- src/main/clojure/clojure/data/json.clj
+++ src/main/clojure/clojure/data/json.clj
@@ -478,10 +478,23 @@
               (.append out (char cp)))))))
     (.append out \")))

+(defn- write-indent [^Appendable out options]
+  (let [indent-depth (:indent-depth options)]
+    (.append out \newline)
+    (loop [i indent-depth]
+      (when (pos? i)
+        (.append out "  ")
+        (recur (dec i))))))
+
 (defn- write-object [m ^Appendable out options]
-  (let [key-fn (:key-fn options)
-        value-fn (:value-fn options)]
+  (let [key-fn (get options :key-fn)
+        value-fn (get options :value-fn)
+        indent (get options :indent)
+        opts (cond-> options
+               indent (update :indent-depth inc))]
     (.append out \{)
+    (when (and indent (seq m))
+      (write-indent out opts))
     (loop [x m, have-printed-kv false]
       (when (seq x)
         (let [[k v] (first x)
@@ -493,26 +506,41 @@
           (if-not (= value-fn out-value)
             (do
               (when have-printed-kv
-                (.append out \,))
-              (write-string out-key out options)
+                (.append out \,)
+                (when indent
+                  (write-indent out opts)))
+              (write-string out-key out opts)
               (.append out \:)
-              (-write out-value out options)
+              (when indent
+                (.append out \space))
+              (-write out-value out opts)
               (when (seq nxt)
                 (recur nxt true)))
             (when (seq nxt)
-              (recur nxt have-printed-kv)))))))
+              (recur nxt have-printed-kv))))))
+    (when (and indent (seq m))
+      (write-indent out options)))
   (.append out \}))

 (defn- write-array [s ^Appendable out options]
-  (.append out \[)
-  (loop [x s]
-    (when (seq x)
-      (let [fst (first x)
-            nxt (next x)]
-        (-write fst out options)
-        (when (seq nxt)
-          (.append out \,)
-          (recur nxt)))))
+  (let [indent (get options :indent)
+        opts (cond-> options
+                  indent (update :indent-depth inc))]
+    (.append out \[)
+    (when (and indent (seq s))
+      (write-indent out opts))
+    (loop [x s]
+      (when (seq x)
+        (let [fst (first x)
+              nxt (next x)]
+          (-write fst out opts)
+          (when (seq nxt)
+            (.append out \,)
+            (when indent
+              (write-indent out opts))
+            (recur nxt)))))
+    (when (and indent (seq s))
+      (write-indent out options)))
   (.append out \]))

 (defn- write-bignum [x ^Appendable out options]
@@ -616,7 +644,9 @@
                             :sql-date-converter default-sql-date->instant-fn
                             :date-formatter java.time.format.DateTimeFormatter/ISO_INSTANT
                             :key-fn default-write-key-fn
-                            :value-fn default-value-fn})
+                            :value-fn default-value-fn
+                            :indent false
+                            :indent-depth 0})
 (defn write
   "Write JSON-formatted output to a java.io.Writer. Options are
    key-value pairs, valid options are:


don't split up actions if they don't have a type

--- frontend/components/build_steps.cljs
+++ frontend/components/build_steps.cljs
@@ -66,7 +66,7 @@
                                     (when (action-model/failed? action)
                                       ["failed"]))]
         (html
-         [:div {:class (str "type-" (:type action))}
+         [:div {:class (str "type-" (or (:type action) "none"))}
           [:div.type-divider
            [:span (:type action)]]
           [:div.build-output


Add function to dispatch next step in the discussion

--- src/discuss/communication/lib.cljs
+++ src/discuss/communication/lib.cljs
@@ -8,7 +8,8 @@
             [discuss.config :as config]
             [discuss.utils.common :as lib]
             [discuss.parser :as parser]
-            [discuss.utils.logging :as log]))
+            [discuss.utils.logging :as log]
+            [discuss.translations :refer [translate] :rename {translate t}]))

 ;;;; Auxiliary functions
 (defn make-url
@@ -22,18 +23,35 @@
   (when (lib/logged-in?)
     {"X-Authentication" (lib/clj->json {:type "user" :nickname (lib/get-nickname) :token (lib/get-token)})}))

+(defn login-or-add-item
+  "Check if user is logged in. If not, present item to login. Else present item
+  which triggers the add-form."
+  [logged-in?]
+  (let [translation (if logged-in? (t :discussion :add-position) (t :login :item))
+        url (if logged-in? "add" "login")]
+    {:htmls [translation]
+     :texts [translation]
+     :url url}))
+
 (defn process-and-set-items-and-bubbles
   "Receive response and prepare UI with the new items and bubbles for the next
-  step in the discussion."
+  step in the discussion.
+
+  Dispatch the current add-step, which is the new expected statement or
+  position, which is to be added in the next step."
   [response]
-  (let [{:keys [bubbles attitudes items attacks]} (lib/process-response response)
+  (let [{:keys [bubbles attitudes items attacks positions]} (lib/process-response response)
+        add-step (if (seq positions) :add/position :add/statement)
         update-items (cond
                        (seq items) items
+                       (seq positions) (conj positions (login-or-add-item (lib/logged-in?)))
                        (seq attacks) (vals attacks)
                        (seq attitudes) (vals attitudes)
                        :default [])]
     (om/transact! parser/reconciler `[(discussion/bubbles {:value ~bubbles})
-                                      (discussion/items {:value ~update-items})])))
+                                      (discussion/items {:value ~update-items})
+                                      (discussion/add-step {:value ~add-step})])))
+

 ;;;; Handlers
 (defn error-handler
@@ -51,7 +69,7 @@
   "Make ajax call to dialog based argumentation system."
   ([url headers handler params]
    (lib/last-api! url)
-   (log/debug "[ajax-get]" "Request to:" (make-url url))
+   (log/debug "GET Request to:" (make-url url))
    (GET (make-url url)
         {:handler       handler
          :headers       (merge (token-header) headers)
@@ -123,3 +141,7 @@

 (s/fdef process-and-set-items-and-bubbles
         :args (s/cat :response ::response))
+
+(s/fdef login-or-add-item
+  :args (s/cat :logged-in? boolean?)
+  :ret ::item)


Added read and read-type functions. Added some symbol filtering.

--- core.clj
+++ core.clj
@@ -32,6 +32,7 @@
           [clojure.string :refer [trim]])
   (:import
    [UnityEngine Time Mathf Debug]
+   [RSG Promise IPromise]
    [seawisphunter.minibuffer Minibuffer Command Prompt Keymap ICompleter]))

 (defn do-with-minibuffer
@@ -54,14 +55,16 @@
     [minibuffer-var & body]
     `(do-with-minibuffer (fn [~minibuffer-var] ~@body)))

-(defn- generate-generic-type
+(defmacro generate-generic-type
   "Like generate-generic-delegate but just provides the type.

 e.g. (generate-generic-type 'Dictionary [String String])
        -> |Dictionary`2[System.String,System.String]|"
   [typename typesyms]
   (let [types (map (fn [tsym]
-                       (clojure.lang.CljCompiler.Ast.HostExpr/MaybeType tsym false))
+                       (if-let [t (clojure.lang.CljCompiler.Ast.HostExpr/MaybeType tsym false)]
+                               t
+                               (throw (ArgumentException. (format "Unable to convert '%s' to a type." tsym)))))
                    typesyms)
        ftype (symbol (str typename "`" (count types) "[" (clojure.string/join "," types) "]"))]
        ftype))
@@ -401,10 +404,13 @@
            (message "No such function \"%s\"." function)))

 (defn make-func-completer
-  "Convert a fn into a ICompleter. The function accepts the current input and
+  "Convert a fn into a ICompleter. The completer accepts the current input and
   returns a list of potential matches (does not have to be sorted).

-  e.g. (f \"Sh\") -> (\"Shane\" \"Shawn\" \"Shannon\")"
+The coercer accepts two arguments, the selected string and the desired type.
+
+  e.g. (f \"Sh\") -> (\"Shane\" \"Shawn\" \"Shannon\")
+       (f \"Shane\" clojure.lang.Symbol) -> 'Shane"
   [completer-fn]
   (CompleterEntity. (reify ICompleter
                            (Complete [this input]
@@ -438,9 +444,75 @@
      [map]
      (CompleterEntity. (DictCompleter. (into-dict-string-string map))))

+;; Not generic
+;; (defn then
+;;   [cs-promise f]
+;;   (let [ptype (generate-generic-type IPromise [String])
+;;        atype (generate-generic-type Action [String])
+;;        meth (.GetMethod ptype "Then" (into-array Type [atype]))]
+;;        (.Invoke meth cs-promise (into-array Object [(sys-action [String] [s] (f s))]))))
+
+;; Generic
+(defn then
+  "Given a RSG.IPromise<T> run (f result-value) when the promise resolves."
+  [ipromise f]
+  (let [ptype (type ipromise)
+       of-type (.GetGenericArguments ptype)
+       atype (eval `(generate-generic-type Action ~of-type))
+       meth (.GetMethod ptype "Then" (into-array Type [atype]))
+       arg #_(eval `(sys-action ~(apply vector of-type) [~'s] (~f ~'s)))
+       (. clojure.lang.GenDelegate Create atype f)
+       ]
+       (.Invoke meth ipromise (into-array Object [arg]))))
+
+(defn pcatch
+  "Given an RSG.IPromise p, if p is rejected, run (f e) where e is the
+  exception.
+
+Note: named pcatch to not conflict with try/catch builtin."
+  [ipromise f]
+  (.Catch ipromise (sys-action [Exception] [e] (f e))))
+
+(defn read
+  "Read a string from the minibuffer prompt. This returns an IPromise.
+
+e.g. (then (read \"Who are you? \") #(message \"Hi, %s.\" %))"
+  [prompt & {:keys [input history completer require-match require-coerce]
+             :or {input "" history nil completer nil
+                  require-match false require-coerce false}}]
+  (with-minibuffer
+   m
+   (.Read m prompt input history completer require-match require-coerce)
+   ;; I was considering using Clojure's promises, but they seem
+   ;; anemic: not then-able, no fail state. Will stick with
+   ;; IPromise library.
+
+   ;; (let [p (promise)]
+   ;;      (then
+   ;;       (.Read m prompt input history completer require-match require-coerce)
+   ;;       (fn [result]
+   ;;           (deliver p result)))
+   ;;      p)
+   ))
+
+(defn read-type
+  [type prompt & {:keys [input history completer require-match require-coerce]
+                  :or {input "" history nil completer nil
+                       require-match false require-coerce false}}]
+  (let [read-method
+    (MinibufferExtensions/GetMethodGeneric
+     Minibuffer "Read"
+     (into-array Type [type])
+     (into-array Type [String String String String Boolean Boolean]))]
+     (with-minibuffer
+      m
+      (.Invoke read-method m (into-array Object [prompt input history completer
+                                                 require-match require-match])))))
+
+
 (defn set-completer
   "Add a completer to Minibuffer. Any fn, list, or map will be automatically
-coerced to a completer type unless `:coerce?' false is added to the arguments."
+coerced to a completer type unless `:coerce? false' is added to the arguments."
   [name completer & {:keys [coerce?]
                      :or {coerce? true}}]
   (let [c (if coerce?
@@ -469,22 +541,20 @@
                item
                :else
                (throw (MinibufferException.
-                       (format "Unable to convert \"%s\" to desired type %s." item desired-type))))
-         ))
-
-(defn filter-ns-map [ns excluded]
-  (let [excluded* (set (map (comp ns-name the-ns) excluded))]
-      (->> (the-ns ns)
-        (ns-refers)
-        (vals)
-        (filter (fn [kv]))
-        (first)
-        (var->ns)
-        (ns-name)
-        (contains? excluded*)
-        ))
-
-  )
+                       (format "Unable to convert \"%s\" to desired type %s." item desired-type))))))
+
+;; (defn filter-ns-map [ns excluded]
+;;   (let [excluded* (set (map (comp ns-name the-ns) excluded))]
+;;       (->> (the-ns ns)
+;;         (ns-refers)
+;;         (vals)
+;;         (filter (fn [kv]))
+;;         (first)
+;;         (var->ns)
+;;         (ns-name)
+;;         (contains? excluded*)
+;;         ))
+;;   )

 (defn filter-fns [amap]
   (into {} (filter #(let [v (val %)]
@@ -495,18 +565,20 @@
                          (and (bound? v) (not (fn? @v)))) amap)))

 (defn filter-sources [amap]
-;;  (prn "ok")
   (into {} (filter #(let [k (key %)]
-                         ;;(prn "checking" k)
                          (try (clojure.repl/source-fn k)
-                              (catch Exception e nil)))
+                              (catch Exception e
+                                     nil)))
                    amap)))

-(defn filter-ns-map [ns excluded]
+;; (ns-refers (the-ns ns))
+(defn filter-ns [excluded amap]
   (let [excluded* (set (map (comp ns-name the-ns) excluded))
-       m (ns-refers (the-ns ns))]
+        m amap]
        (select-keys m
-                    (for [[k v] m :when (not (contains? excluded* (ns-name (var->ns v)))) ] k))))
+                    (for [[k v] m :when
+                         (not (contains? excluded* (ns-name (var->ns v))))]
+                         k))))

 (defn repl-setup


other

other

--- core.clj
+++ core.clj
@@ -139,6 +139,8 @@
             (set! (.name gob) (.name source))
             (swap! CLONED #(cons gob %)) gob)))))

+
+
 (defn data! [o v] (swap! _DATA_ conj {o v}) o)

 (defn data [o] (get @_DATA_ o))
@@ -450,4 +452,3 @@

 '(arcadia.core/log "hard.core is here")

-