Use MemoryStack to reduce buffer allocations

--- src/zaffre/font.cljc
+++ src/zaffre/font.cljc
@@ -10,19 +10,29 @@
            (java.nio ByteBuffer)
            (java.nio.file Files Path)
            (org.lwjgl BufferUtils)
+           (org.lwjgl.system MemoryStack)
            (org.lwjgl.stb STBTruetype STBTTFontinfo)
            (org.apache.commons.io IOUtils)))

 (set! *warn-on-reflection* true)
 (set! *unchecked-math* true)
+
+(defmacro defn-ms [name [memory-stack & args] & body]
+  `(defn ~name [~memory-stack ~@args]
+     (.push ~memory-stack)
+     (try
+       ~@body
+       (finally
+         (.pop ~memory-stack)))))

 (def calls (atom []))
 ;(add-watch calls :persist
 ;  (fn [_ _ _ calls]
 ;    (spit "calls.log" calls)))

-
 (defn log-call [method-name & args]
+  (spit "calls.log" {:method-name method-name :args args} :append true)
+  (spit "calls.log" "\n" :append true)
   (swap! calls (fn [calls] (conj calls {:method-name method-name :args args}))))

 (defn- byte-buffer->str [^ByteBuffer buffer]
@@ -226,26 +236,26 @@
       compact-image)
     image))

-(defn- hmetrics [^STBTTFontinfo font-info glyph-index]
-  (let [advance-width     (BufferUtils/createIntBuffer 1)
-        left-side-bearing (BufferUtils/createIntBuffer 1)]
+(defn-ms hmetrics [^MemoryStack ms ^STBTTFontinfo font-info glyph-index]
+  (let [advance-width     (.mallocInt ms 1)
+        left-side-bearing (.mallocInt ms 1)]
     (log-call "STBTruetype/stbtt_GetGlyphHMetrics" font-info (int glyph-index) advance-width left-side-bearing)
     (STBTruetype/stbtt_GetGlyphHMetrics font-info (int glyph-index) advance-width left-side-bearing)
     [(.get advance-width) (.get left-side-bearing)]))

-(defn- vmetrics [^STBTTFontinfo font-info]
-  (let [ascent   (BufferUtils/createIntBuffer 1)
-        descent  (BufferUtils/createIntBuffer 1)
-        line-gap (BufferUtils/createIntBuffer 1)]
+(defn-ms vmetrics [^MemoryStack ms ^STBTTFontinfo font-info]
+  (let [ascent   (.mallocInt ms 1)
+        descent  (.mallocInt ms 1)
+        line-gap (.mallocInt ms 1)]
     (log-call "STBTruetype/stbtt_GetFontVMetrics" font-info ascent descent line-gap)
     (STBTruetype/stbtt_GetFontVMetrics font-info ascent descent line-gap)
     [(.get ascent) (.get descent) (.get line-gap)]))

-(defn- glyph-bitmap-box [^STBTTFontinfo font-info scale glyph-index]
-  (let [ix0 (BufferUtils/createIntBuffer 1)
-        iy0 (BufferUtils/createIntBuffer 1)
-        ix1 (BufferUtils/createIntBuffer 1)
-        iy1 (BufferUtils/createIntBuffer 1)]
+(defn-ms glyph-bitmap-box [^MemoryStack ms ^STBTTFontinfo font-info scale glyph-index]
+  (let [ix0 (.mallocInt ms 1)
+        iy0 (.mallocInt ms 1)
+        ix1 (.mallocInt ms 1)
+        iy1 (.mallocInt ms 1)]
     (log-call "STBTruetype/stbtt_GetGlyphBitmapBox"
       font-info
       (int glyph-index)
@@ -267,11 +277,11 @@
     [(.get ix0) (.get iy0) (.get ix1) (.get iy1)]))

-(defn- char-image [font-info char-width char-height ascent scale codepoint glyph-index]
+(defn- char-image [ms font-info char-width char-height ascent scale codepoint glyph-index]
   (let [;scale 0.015625
-        [x0 y0 x1 y1]         (glyph-bitmap-box font-info scale glyph-index)
+        [x0 y0 x1 y1]         (glyph-bitmap-box ms font-info scale glyph-index)
         baseline              (int (* ascent scale))
-        [_ left-side-bearing] (map (partial * scale) (hmetrics font-info glyph-index))
+        [_ left-side-bearing] (map (partial * scale) (hmetrics ms font-info glyph-index))
         y                     (+ baseline y0)
         img                   (zimg/image char-width char-height 1)
         chr-img               (zimg/image char-width char-height 1)]
@@ -362,13 +372,15 @@
   GlyphGraphics
   (glyph-graphics [this]
     ;; Adjust canvas to fit character atlas size
-    (let [^STBTTFontinfo font-info   (make-font name-or-path)
+    (let [ms (MemoryStack/create)
+          ^STBTTFontinfo font-info   (make-font name-or-path)
           scale                      (STBTruetype/stbtt_ScaleForPixelHeight
                                        font-info
                                        size)
           [advance
            left-side-bearing]        (map (partial * scale)
-                                       (hmetrics font-info
+                                       (hmetrics ms
+                                                 font-info
                                                  (STBTruetype/stbtt_FindGlyphIndex
                                                    font-info
                                                    (int \M))))
@@ -377,7 +389,7 @@
           char-height                size
           [ascent
            descent
-           line-gap]                 (vmetrics font-info)
+           line-gap]                 (vmetrics ms font-info)
           _ (log/info "characters per line" (characters-per-line char-width (count characters)))
           cwidth     2048
           cheight    (zutil/next-pow-2 (* char-height (int (Math/ceil (/ (count characters)
@@ -394,11 +406,11 @@
       ;(log/info "character-idxs" (vec (character-idxs characters)))
       (let [texture-image (zimg/image width height)]
         ;; Loop through each character, drawing it
-        (doseq [[[codepoint glyph-index] col row]  (reverse char-idxs)]
+        (doseq [[[codepoint glyph-index] col row] char-idxs]
           (try
             (let [x  (* col char-width)
                   y  (* row char-height)
-                  chr-img (char-image font-info char-width char-height ascent scale codepoint glyph-index)]
+                  chr-img (char-image ms font-info char-width char-height ascent scale codepoint glyph-index)]
               #_(log/info "drawing" codepoint "@" x y)
               (zimg/draw-image texture-image
                              chr-img
@@ -415,7 +427,6 @@
          :character-height char-height
          :character->col-row (character->col-row char-idxs)
          :character->transparent (zipmap characters (repeat transparent))}))))
-

 (defrecord CompositeFont [fonts]
   GlyphGraphics


cleanup old code

cleanup old code

--- src/babel/english/writer.clj
+++ src/babel/english/writer.clj
@@ -3,7 +3,6 @@

 (require '[babel.config :refer [language-to-root-spec]])
 (require '[babel.directory :refer [models]])
-(require '[babel.english.lexicon :refer [lexicon]])
 (require '[babel.english.morphology :refer [fo]])
 (require '[babel.generate :refer [generate]])
 (require '[babel.reader :refer [read-all read-one]])
@@ -15,8 +14,10 @@
 (require '[clojure.tools.logging :as log])
 (require '[dag_unify.core :refer (fail? get-in strip-refs unify)])

+(def lexicon (-> (-> ((-> models :en)) deref) :lexicon))
+
 (defn rewrite-lexicon []
-  (write-lexicon "en" @lexicon))
+  (write-lexicon "en" lexicon))

 (defn translate [source-language-short-name & [root]]
   "Generate translations from source language (e.g. 'it' for Italian) into English.


s/map/pmap/

s/map/pmap/

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -37,7 +37,7 @@
         ;; for debugging: use map: in-order rather than interleaved by multiple workers.
         ;; for production: use pmap.
         ;;        use-map-fn pmap
-        use-map-fn map
+        use-map-fn pmap

         root-verbs
         (zipmap


Toolbar rewind buttons change state based on active state

--- src/cljs/mathom/toolbar.cljs
+++ src/cljs/mathom/toolbar.cljs
@@ -1,7 +1,7 @@

 (ns mathom.toolbar)

-(def tool (atom {:selected nil}))
+(def tool (atom {}))

 (defn clean
   []
@@ -28,7 +28,8 @@
   [d]
   (clojure.string/join " "
                        (for [[k v] d]
-                         (str (name k) "=\"" v "\""))))
+                         (if v
+                           (str (name k) "=\"" v "\"")))))

 (defn h
@@ -59,11 +60,21 @@
 (defn render
   [statedb]
   (let [states (:states statedb)
-        active (:active_state statedb)]
+        active (:active_state statedb)
+        prev (if (> active 0) true false)
+        next (if (= active (count states)) true false)]
     (set-content (:bar @tool)
                  (h "div" {} [(h "h1" {} ["Mathom Toolbar"])
-                              (h "button" {:id "mathom_toolbar_prev"} ["Previous state"])
-                              (h "button" {:id "mathom_toolbar_next"} ["Next state"])
+                              (h "button"
+                                 {:id       "mathom_toolbar_prev"
+                                  :class "pure-button"
+                                  :disabled (not prev)}
+                                 ["Previous state"])
+                              (h "button"
+                                 {:id       "mathom_toolbar_next"
+                                  :class "pure-button"
+                                  :disabled (not next)}
+                                 ["Next state"])
                               (h "span"
                                  {:id "mathom_toolbar_states"}
                                  ["Saved states: " (count states)


add a bunch of examples

add a bunch of examples

--- src/cljs/uberblick/core.cljs
+++ src/cljs/uberblick/core.cljs
@@ -22,10 +22,7 @@

 (defonce people-atom (atom []))
 (defonce filters (atom [
-                       ;; "(.startsWith :Name \"M\")"
-                        ;; (= :LaborRoleID "APPLDEVL")
-                        ;; (> (.indexOf :Title "Quality") -1)
-
+
                         ]))

 (def all-profile-keys '(:IsObjectivesAdmin :LaborCategoryID :FirstName :LaborRoleID :OversightPercent :WorkTeamID :BusinessUnitName :MobileNumber :PhotoFileName :IsCandidateAdmin :CanCommunicateClient :UserSystemID :Email :CreatedDate :BillingTargetHoursPerYear :Title :MobileNumberCountryCode :IsClient :IsScheduleConfirmationRulesEnforced :LastName :IsScheduleAdmin :UserName :Extension :TimeZoneName :HomeNumber :IsNotAPerson :UserID :KeyscanUpdated :HasDirectReports :IsAdmin :BusinessUnitID :CountryID :CompanyBusinessUnitID :TimeZoneID :PhotoPath :Name :Roles :CompanyBusinessUnitName :IsWeeklyReviewAdmin :Enabled :TagName :Supervisors :KeyscanStatus :OutOfOfficeReason :Status))
@@ -224,11 +221,25 @@
                   ;; [:li (str filter)]
                   [:li.collection-item (str filter) [:a.secondary-content {:on-click #(remove-filter idx)} [:i.material-icons "delete"]]]) @filters)])

+(defn Examples [filter-examples]
+  [:ul.collection
+   (map-indexed (fn [idx filter]
+                  ^{:key filter}
+                  [:li.collection-item filter [:a.secondary-content {:on-click #(add-filter filter)} [:i.material-icons "add"]]]) filter-examples)])
+
 (defn Filters []
   [:div
    [:h3 "Filters"]
    [Current-Filters]
    [New-Filter-Field]
+   [:hr]
+   [:h3 "Examples"]
+   [:p "Here are some example filters to get you started!"]
+   [Examples [
+              "(startsWith? :FirstName \"M\")"
+              "(= :LaborRoleID \"APPLDEVL\")"
+              "(substring? :Title \"Quality\")"
+              ]]
    [:hr]
    [:h3 "References"]
    [Instructions]])


pack string retains

pack string retains

--- src/cljx/transom/string.cljx
+++ src/cljx/transom/string.cljx
@@ -81,7 +81,7 @@
 (defn diff
   [a b]
   (if (= a b)
-    [[:retain (count a)]] ;; don't forget to wrap it dummy
+    (pack [[:retain (count a)]]) ;; don't forget to wrap it dummy
     (let [pre (common-prefix a b)
           suf (common-suffix a b)]
       (if (< pre suf)


don't need logout tooltip anymore

don't need logout tooltip anymore

--- src-cljs/frontend/components/app.cljs
+++ src-cljs/frontend/components/app.cljs
@@ -74,8 +74,7 @@
                                                                    (.-href)
                                                                    (url/url)
                                                                    :path)}]
-            [:a.action-logout {:on-click #(.submit (om/get-node owner "logout-form"))
-                               :data-right "Logout"}
+            [:a.action-logout {:on-click #(.submit (om/get-node owner "logout-form"))}
              (common/icon :logout)]]
            [:a.action-login {:href (auth/auth-url)
                              :data-right (when-not login-button-learned? "Sign Up")


more generic run! error handling

more generic run! error handling

might run into other errors besides not found

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -67,13 +67,27 @@
 ;; same as run! but preserves the exit code of the process
 ;; must be run as the last step since it will kill the node process after
 (defn run! [project-root cmd args proc-opts]
-  (let [^js result (run project-root cmd args proc-opts)]
-
-    (when (and (.-error result) (= "ENOENT" (.. result -error -errno)))
-      (log (str "shadow-cljs - failed to execute \"" cmd "\", command not found.")))
-
-    (js/process.exit (.-status result))
-    ))
+  (let [^js result (run project-root cmd args proc-opts)
+
+        error
+        (.-error result)
+
+        status
+        (.-status result)]
+
+    (cond
+      (and error (= "ENOENT" (. error -errno)))
+      (log (str "shadow-cljs - failed to execute \"" cmd "\", command not found."))
+
+      error
+      (log (str "shadow-cljs - failed to execute \"" cmd "\", " (. error -message)))
+
+      (number? status)
+      (js/process.exit status)
+
+      :else
+      (log (str "shadow-cljs - command completed without status " (pr-str result)))
+      )))

 (defn run-java [project-root args opts]
   (let [^js result


Add mock for /api/library-version method.

--- web-server/src/clj/hatnik/web/server/handler.clj
+++ web-server/src/clj/hatnik/web/server/handler.clj
@@ -11,18 +11,25 @@
             [hatnik.web.server.login :refer [login-api]]
             [hatnik.config :refer [config]]

+            [ring.util.response :as resp]
             [ring.middleware.json :as json]
             [ring.adapter.jetty :refer [run-jetty]]
             [ring.middleware.stacktrace :as stacktrace]))

 (timbre/set-level! (:log-level config))

+(defn library-version [group artifact]
+  (resp/response
+   {:result :ok
+    :version "1.6.0"}))
+
 (defroutes app-routes
   (GET "/" [] renderer/core-page)
   (context "/api" []
            (context "/projects" [] projects-api)
            (context "/actions" [] actions-api)
-           login-api)
+           login-api
+           (GET "/library-version" [group artifact] (library-version group artifact)))
   (route/resources "/")
   (route/not-found "Not Found"))


Logs at start and end of job ranking (#1642)

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -1469,8 +1469,10 @@
         offensive-job-filter (partial filter-offensive-jobs task-constraints offensive-jobs-ch)]
     (tools/chime-at-ch trigger-chan
                       (fn rank-jobs-event []
+                        (log/info "Starting pending job ranking")
                         (reset! pool-name->pending-jobs-atom
-                                (rank-jobs (d/db conn) offensive-job-filter))))))
+                                (rank-jobs (d/db conn) offensive-job-filter))
+                        (log/info "Done with pending job ranking")))))

 (meters/defmeter [cook-mesos scheduler mesos-error])
 (meters/defmeter [cook-mesos scheduler offer-chan-full-error])


Update to ClojureScript 0.0-2814

Update to ClojureScript 0.0-2814

--- Clojure/project.clj
+++ Clojure/project.clj
@@ -4,7 +4,7 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/clojurescript "0.0-2760"]]
+                 [org.clojure/clojurescript "0.0-2814"]]
   :source-paths ["src"]
   :compiler {
      :output-dir "out"


Version 0.6.5-SNAPSHOT

Version 0.6.5-SNAPSHOT

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-vault "0.6.4"
+(defproject metlog-vault "0.6.5-SNAPSHOT"
   :description "Repository for storing and displaying time series data reported by metlog-agent.."

   :license {:name "Eclipse Public License"


Reverse interleave problem added

Reverse interleave problem added


Whitespace fixes, courtesy of Emacs, I guess.

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -22,9 +22,9 @@
   (from-mongo
    (fetch-one :problems :where {:_id x})))

-(defn get-problem-list
+(defn get-problem-list
   ([] (get-problem-list {:approved true}))
-  ([criteria]
+  ([criteria]
      (from-mongo
       (fetch :problems
              :only [:_id :title :tags :times-solved :user]
@@ -430,7 +430,7 @@
         :to [email]
         :subject "Problem rejected"
         :body
-        (str "A problem you've submitted has been rejected, but don't get discouraged!  Check out the reason below, and try again.\n\n"
+        (str "A problem you've submitted has been rejected, but don't get discouraged!  Check out the reason below, and try again.\n\n"
              "Title: " title "\n"
              "Tags: " tags "\n"
              "Description: " description "\n"


Use div#foo instead of div {:id "foo"}, which we were doing all over

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -188,19 +188,22 @@
   (let [{:keys [title tags description restricted tests approved user]}
         (get-problem (Integer. id))]
     [:div
-     [:span {:id "prob-title"} (if approved title (str "Unapproved: " title))]
+     [:span#prob-title
+      (when-not approved
+        "Unapproved: ")
+      title]
      [:hr]
-     [:div {:id "tags"} "Tags: "
+     [:div#tags "Tags: "
       (s/join " " tags)]
      [:br]
-     (if (not approved)
-       [:div {:id "submitter"} "Submitted by: " user])
+     (when-not approved
+       [:div#submitter "Submitted by: " user])
      [:br]
-     [:div {:id "prob-desc"}
+     [:div#prob-desc
       description[:br]
       (render-test-cases tests)
       (when restricted
-        [:div {:id "restrictions"}
+        [:div#restrictions
          [:u "Special Restrictions"] [:br]
          (map (partial vector :li) restricted)])]
      [:div
@@ -217,13 +220,12 @@
        (hidden-field :id id)
        [:br]
        [:button.large {:id "run-button" :type "submit"} "Run"]
-       (if (not approved)
-         [:button.large {:id "approve-button"} "Approve"]))
-     ]))
+       (when-not approved
+         [:button.large#approve-button "Approve"]))]))

 (def-page problem-page []
   [:div.message (session/flash-get :message)]
-  [:div.error {:id "problems-error"} (session/flash-get :error)]
+  [:div.error#problems-error (session/flash-get :error)]
   (link-to "/problems/rss" [:div {:class "rss"}])
   [:table#problem-table.my-table
    [:thead
@@ -252,7 +254,7 @@

 (def-page unapproved-problem-page []
   [:div.message (session/flash-get :message)]
-  [:div.error {:id "problems-error"} (session/flash-get :error)]
+  [:div.error#problems-error (session/flash-get :error)]
   [:table#unapproved-problems.my-table
    [:thead
     [:tr


Allow changing the rendered labyrinth

Allow changing the rendered labyrinth


Style issue: pass a map not an atom

Style issue: pass a map not an atom

--- src/oxcart/passes/lambda_lift.clj
+++ src/oxcart/passes/lambda_lift.clj
@@ -51,7 +51,7 @@
 (defn rewrite-locals-to-vars
   [mapping ast]
   (if (pattern/local? ast)
-    (get @mapping (:name ast) ast)
+    (get mapping (:name ast) ast)
     ast))

@@ -122,7 +122,7 @@
           (-> ast
               (assoc :bindings (mapv #(ast/prewalk %1
                                         (partial rewrite-locals-to-vars
-                                                 locals->vars))
+                                                 @locals->vars))
                                      bindings))

               (collect-closed-overs {:what #{:closed-overs} :where #{:fn}})


display steepest hill distance

display steepest hill distance

--- src-cljs/flatride/frontend.cljs
+++ src-cljs/flatride/frontend.cljs
@@ -38,7 +38,9 @@
                            longest-slope :longest-slope
                            steepest-slope :steepest-slope}]
   (let [div (nth (sel :div.routeData) idx)]
-    (dommy/append! div (node [:span (->> steepest-slope slope-diff (gstring/format "%.2f"))]))))
+    (dommy/append! div (node [:span (->> steepest-slope slope-diff (gstring/format "%.2f"))]))
+    (dommy/append! div (node [:span "    LOLOLOL     "]))
+    (dommy/append! div (node [:span (->> (gps-distance (:coordinates (first steepest-slope)) (:coordinates (last steepest-slope))) (gstring/format "%.2f"))]))))

 (defn get-routes []
   (let [from (dommy/value (sel1 :#input-from))


Fix typo

Fix typo

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -139,5 +139,5 @@
         (is (not= n3 n1))))

     (let [scheme (fn [ptext] (ms/secretbox-nmr ptext st/secret-key))]
-      (is (not (repeated-keystream? scheme)))))
+      (is (not (repeated-keystream? scheme))))))


Make dummy reader card test look a bit more real

--- test/cljs/comic_reader/ui/reader_test.cljs
+++ test/cljs/comic_reader/ui/reader_test.cljs
@@ -99,7 +99,11 @@
 (defcard-rg comic-image-reader
   (fn [data _]
     (let [set-data! #(swap! data assoc :current-location %)
-          locations []]
+          locations [{:location/chapter {:chapter/title "The Gamer 1"
+                                         :chapter/url "http://www.mangareader.net/the-gamer/1"
+                                         :chapter/number 1}
+                      :location/page {:page/number 1
+                                      :page/url "http://www.mangareader.net/the-gamer/1"}}]]
       [sut/reader set-data! locations]))
   (reagent/atom {})
   {:inspect-data true})


Whitespace

Whitespace

--- test/onyx/peer/deterministic_peer_test.clj
+++ test/onyx/peer/deterministic_peer_test.clj
@@ -464,7 +464,8 @@
               (clojure.set/difference (set flattened-outputs)
                                       (set expected-outputs))])
     ;; FIXME requires fix to how tasks can be blocked. See above trigger
-    ;(prop-is (= (set expected-outputs) (set (map reset-peer-path flow-outputs))) "messenger flow values incorrect")
+    ;(prop-is (= (set expected-outputs) (set (map reset-peer-path flow-outputs)))
+    ;         "messenger flow values incorrect")
     (check-outputs-in-order! peer-outputs)
     (state-properties expected-state @state-atom)))


Disable XSS protection in middleware config

--- src/ktra_indexer/handler.clj
+++ src/ktra_indexer/handler.clj
@@ -59,10 +59,14 @@
         defaults (if dev-mode
                    site-defaults
                    secure-site-defaults)
-        ;; CSRF protection is knowingly not implemented
-        ;; :params and :static options are disabled as Reitit handles them
+        ;; CSRF protection is knowingly not implemented.
+        ;; XSS protection is disabled as it is no longer recommended to enabled,
+        ;; it will soon be disabled in ring-defaults.
+        ;; :params and :static options are disabled as Reitit handles them.
         defaults-config (-> defaults
                             (assoc-in [:security :anti-forgery]
+                                      false)
+                            (assoc-in [:security :xss-protection]
                                       false)
                             (assoc :params false)
                             (assoc :static false))]


some useful msg

some useful msg

--- src/leiningen/namespaces.clj
+++ src/leiningen/namespaces.clj
@@ -80,9 +80,8 @@
   (try
     (io/make-parents (io/file to-file))
     (spit (io/file to-file) (slurp (io/file from-file)))
-    (m/info "* " to-file)
     (catch FileNotFoundException e
-      (m/info "* Could not synchronize" to-file "because: " (.getMessage e)))))
+      (m/info "* Could not update" to-file "because: " (.getMessage e)))))

 (defn should-update? [entry-definition entry target-project]
   (-> target-project
@@ -93,8 +92,9 @@
       (contains? entry)))

 (defn initial-question [namespace project]
-  (str "The location of " namespace " on " project
-       " could not be determined.  Please choose one of options:"))
+  (str "* ==> The location of " namespace " on " (str/upper-case project)
+       " could not be determined.\n"
+       "      Please choose one of options (a number):"))

 (defn localtion-question-with
   ([ns project [first & rest]]
@@ -102,7 +102,7 @@
   ([question index first [ffirst rrest]]
    (if (nil? first)
      question
-     (recur (str question "\n* " index " ==> " first)
+     (recur (str question "\n         + " index " -> " first)
             (inc index)
             ffirst
             rrest))))
@@ -118,7 +118,7 @@
   (update-files!
    (if (= 1 (count source-paths))
      (first source-paths)
-     (ask-for-localtion namespace project source-paths))
+     (ask-for-localtion namespace "This Project" source-paths))
    (if (= 1 (count target-paths))
      (first target-paths)
      (ask-for-localtion namespace project target-paths))))
@@ -126,6 +126,7 @@
 (defn update-file-if-exists! [name target-project source-paths target-paths]
   (let [existing-source-paths (filter ns-exists? source-paths)
         existing-target-paths (filter ns-exists? target-paths)]
+    (m/info "* Update" name "to the project" (str/upper-case target-project))
     (cond
       ;source and target exist and unique
       (and (= 1 (count existing-source-paths))
@@ -139,7 +140,7 @@
       ;source  exists, target  doen't exist and its location is unique, so ask user
       (<= 1 (count existing-source-paths))
       (ask-for-localtion-and-update! name target-project existing-source-paths target-paths)
-      ;default: do nothing
+
       :else (m/info "WARNING: Could not find strategy to update" name "on project" target-project
                     "\n    ==>" name "may not exist on the source project"))))

@@ -160,16 +161,16 @@
      (resource->target-path resource target-project read-target-project-clj))))

 (defn update-namespaces! [namspaces source-project-desc]
-  (m/info "\n****************** UPDATE NAMESPACE ******************\n*")
+  (m/info "\n*********************** UPDATE NAMESPACES ***********************\n*")
   (doseq [[namespace project] namspaces]
     (update-name-space! namespace project source-project-desc))
-  (m/info "*\n******************************************************\n"))
+  (m/info "*\n****************************************************************\n"))

 (defn update-resouces! [resources source-project-desc]
-  (m/info "\n****************** UPDATE RESOURCES ******************\n*")
+  (m/info "\n*********************** UPDATE RESOURCES ***********************\n*")
   (doseq [[resource project] resources]
     (update-resource! resource project source-project-desc))
-  (m/info "*\n******************************************************\n"))
+  (m/info "*\n****************************************************************\n"))

 (defn run-cmd [cmd]
   (m/info "... Executing " (str/join " " cmd))


refactor a bit

refactor a bit

--- src/lt/plugins/ltinator.cljs
+++ src/lt/plugins/ltinator.cljs
@@ -52,6 +52,12 @@
   [path]
   (-> path files/basename files/without-ext))

+(defn- add-ext
+  [path extname]
+  (if (empty? (files/ext path))
+    (str path extname)
+    path))
+
 (defn- load-project
   [path]
   (when (files/file? path)
@@ -66,7 +72,7 @@
 (defn- add-items
   []
   (when (check-project-dir)
-    (map #(hash-map :name (-> % files/basename files/without-ext)
+    (map #(hash-map :name (path->project-name %)
                     :path %)
          (files/full-path-ls @project-directory))))

@@ -144,12 +150,9 @@
   [:input {:type "file" :nwsaveas (or path true)}]
   :change (fn []
             (this-as me
-                     (when-not (empty? (dom/val me))
-                       (let [path (if (empty? (files/ext (dom/val me)))
-                                    (str (dom/val me) ".edn")
-                                    (dom/val me))]
-                         (save path project)
-                         (change-opened-project-path path))))))
+                     (let [path (-> me dom/val (add-ext ".edn"))]
+                       (save path project)
+                       (change-opened-project-path path)))))

 ;;;


Set an "Expired" header (now + ten years) for assets

--- src/main/clojure/cascade.clj
+++ src/main/clojure/cascade.clj
@@ -16,9 +16,11 @@
   cascade
   "Core functions and macros used when implementing Cascade views"
   (:import
-    [java.io File FileInputStream BufferedInputStream InputStream])
+    [java.io File FileInputStream BufferedInputStream InputStream]
+    [java.util Calendar Date])
   (:require
-    [ring.util.response :as ring])
+    [ring.util.response :as ring]
+    [ring.middleware.file-info :as file-info])
   (:use
     [compojure core]
     [cascade dom]
@@ -118,7 +120,9 @@
   [asset]
   (let [stream (content asset)]
     (if stream
-      (-> (ring/response stream)
+      (->
+        (ring/response stream)
+        (ring/header "Expires" (@asset-configuration :expiration))
         (ring/content-type (get-content-type asset))))))

 (defn wrap-exception-handling
@@ -127,6 +131,16 @@
   [handler]
   ; Just a placeholder for now
   handler)
+
+(defn- now-plus-ten-years
+  "Returns a string representation of the current Date plus ten years, used for setting expiration date of assets."
+  []
+  (let [format (file-info/make-http-format)]
+    (->>
+      (doto (Calendar/getInstance)
+        (.add Calendar/YEAR 10))
+      .getTime
+      (.format format))))

 (defn initialize-assets
   "Initializes asset handling for Cascade. This sets an application version (a value incorporated into URLs, which
@@ -143,6 +157,7 @@
   (let [root (str "/" virtual-folder "/" application-version)]
     (reset! asset-configuration
       {:application-version application-version
+       :expiration (now-plus-ten-years)
        :public-folder public-folder
        :virtual-folder virtual-folder
        :file-path (str root "/file/")


works but slow

works but slow

--- Alfa/src/alfa/five.clj
+++ Alfa/src/alfa/five.clj
@@ -4,6 +4,35 @@
    [alfa.common :refer :all]
    [clojure.set :refer [intersection difference]]))

+(defn run [f & args]
+  (dotimes [i 5]
+    (let [res (time (apply f args))]
+      (println res))))
+
+(defn ^long p50 [^long lim]
+  (let [refs (boolean-array lim true)
+        llim (inc (int (Math/sqrt lim)))
+        primes (sieve lim)]
+    (loop [i (int 2)]
+      (if (aget refs i)
+        (when (<= i llim)
+          (do (loop [j (int (* i i))]
+                (when (< j lim)
+                  (aset refs j false)
+                  (recur (+ j i))))
+              (recur (+ i 1))))
+        (recur (+ i 1))))
+    (->> primes
+         (iterate rest)
+         (take-while not-empty)
+         (mapcat #(->> (iterate butlast %)
+                       (take-while not-empty)
+                       (keep (fn [x]
+                               (let [res (reduce + x)]
+                                 (when (< res lim)
+                                   [(count x) res]))))))
+         (filter #(aget refs (second %)))
+         (apply max-key first))))


flushing

flushing

--- src/celestial/persistency/systems.clj
+++ src/celestial/persistency/systems.clj
@@ -97,14 +97,15 @@
    [f & args]
      (if (map? (first args))
       (let [id (apply f args) spec (first args)]
-        (es/put (str id) spec) id)
+        (es/put (str id) spec :flush? true) id)
       (apply f args)))

 (defn es-delete
    "reducing usage quotas for owning user on delete"
    [f & args]
   (let [system (first (filter map? args)) id (first (filter number? args))]
-   (when-not (is-system? system) (es/delete (str id))))
+   (when-not (is-system? system)
+     (es/delete (str id) :flush? true)))
    (apply f args))

@@ -112,11 +113,11 @@
   (get-in (get-system id) [:machine :ip]))

 (def hyp-to-v {
-               :physical ph/validate-entity
-               :proxmox pv/validate-entity
-               :docker dv/validate-entity
-               :aws av/validate-entity
-               :vcenter vc/validate-entity})
+   :physical ph/validate-entity
+   :proxmox pv/validate-entity
+   :docker dv/validate-entity
+   :aws av/validate-entity
+   :vcenter vc/validate-entity})

 (validation :type-exists (when-not-nil t/type-exists? "type not found, create it first"))


CMR-285: Updated messages to match changes to search-app.

--- test/cmr/system_int_test/search/paging_search_test.clj
+++ test/cmr/system_int_test/search/paging_search_test.clj
@@ -48,7 +48,7 @@
         (let [status (get-in (ex-data e) [:object :status])
               body (get-in (ex-data e) [:object :body])]
           (is (= 422 status))
-          (is (re-matches #".*page_size 0 is less than 1.*" body))))))
+          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body))))))
   (testing "Negative page size."
     (try
       (search/find-collection-refs {:provider "PROV1"
@@ -57,7 +57,7 @@
         (let [status (get-in (ex-data e) [:object :status])
               body (get-in (ex-data e) [:object :body])]
           (is (= 422 status))
-          (is (re-matches #".*page_size -1 is less than 1.*" body))))))
+          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body))))))
   (testing "Page size too large."
     (try
       (search/find-collection-refs {:provider "PROV1"
@@ -66,7 +66,7 @@
         (let [status (get-in (ex-data e) [:object :status])
               body (get-in (ex-data e) [:object :body])]
           (is (= 422 status))
-          (is (re-matches #".*page_size 2001 is greater than 2000.*" body))))))
+          (is (re-matches #".*page_size must be a number between 1 and 2000.*" body))))))
   (testing "Non-numeric page size"
     (try
       (search/find-collection-refs {:provider "PROV1"
@@ -77,10 +77,4 @@
           (is (= 422 status))
           (is (re-matches #".*page_size must be a number between 1 and 2000.*" body)))))))

-;; TODO Implement this when paging is implemented in search.
-#_(deftest search-with-page-num
-    (testing "Search with page num."
-      (let [references (search/find-collection-refs {:provider "PROV1"
-                                                     :page_size 5
-                                                     :page_num 1})]
-        (is (= 5 (count references))))))
+


remove trace output

remove trace output

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -315,9 +315,6 @@
                           coerced-options
                           {:page 0
                            :per-page 10})]
-
-     (pprint {:parsed-options parsed-options})
-
      (with-storage [s storage-spec]
        (->>
          (select-transactions-by-entity-id s entity-id parsed-options)


compscribe should return unsubs-fn

compscribe should return unsubs-fn

--- src/cljc/commos/delta/compscribe.cljc
+++ src/cljc/commos/delta/compscribe.cljc
@@ -511,7 +511,8 @@
   {:arglists '([target-ch service spec id])}
   ([target-ch service spec id]
    (let [service (compscriber service)]
-     (subscribe service [spec id] target-ch)))
+     (subscribe service [spec id] target-ch)
+     #(cancel service target-ch)))
   ([target-ch subs-fn unsubs-fn spec id]
    (compscribe target-ch
                (let [chs (atom {})]


halo: fetch target-id from local state

halo: fetch target-id from local state

--- src/cljs/cljs_morphic/morph/halo.cljs
+++ src/cljs/cljs_morphic/morph/halo.cljs
@@ -35,12 +35,13 @@
                           :extent {:x 25 :y 25}
                           :id "resizeButton"
                           :position (add-points (props :extent) {:x 0 :y 0})
-                          :draggable? true
-                          :on-drag (fn [world id {dx :x dy :y}]
+                          :draggable? true
+                          :target-id target-id
+                          :on-drag '(fn [world id {dx :x dy :y}]
                                      (-> world
-                                         (redefine ($morph target-id)
-                                                   (fn [target props submorphs]
-                                                     (target (assoc props :extent (add-points (:extent props) {:x (- dx) :y (- dy)})) submorphs)))
+                                       (redefine ($morph (fetch world [($morph id) properties :target-id]))
+                                                   (fn [self props submorphs]
+                                                     (self (assoc props :extent (add-points (:extent props) {:x (- dx) :y (- dy)})) submorphs)))
                                         (redefine ($morph "halo")
                                                   (fn [halo props buttons]
                                                     (let [new-extent (add-points (:extent props) {:x (- dx) :y (- dy)})]


Move code tracing panel to events

Move code tracing panel to events

--- src/day8/re_frame_10x/view/event.cljs
+++ src/day8/re_frame_10x/view/event.cljs
@@ -3,7 +3,9 @@
             [day8.re-frame-10x.view.components :as components]
             [day8.re-frame-10x.common-styles :as common]
             [mranderson047.garden.v1v3v3.garden.units :as units]
-            [mranderson047.re-frame.v0v10v2.re-frame.core :as rf])
+            [mranderson047.re-frame.v0v10v2.re-frame.core :as rf]
+            [zprint.core :as zp]
+            [clojure.string :as str])
   (:require-macros [day8.re-frame-10x.utils.macros :refer [with-cljs-devtools-prefs]]))

 (def pod-border-color "#daddde")
@@ -25,7 +27,7 @@
    [:.event-section--data
     {:background-color "rgba(100, 255, 100, 0.08)"
      :padding-left     (units/px- common/gs-12 common/expansion-button-horizontal-padding)
-     :overflow-x "auto"}]
+     :overflow-x       "auto"}]
    ])

 (defn event-section [title data]
@@ -39,6 +41,71 @@

     [components/simple-render data [title] "event-section--data app-db-path--pod-border"]]])

+;; Terminology:
+;; Form: a single Clojure form (may have nested children)
+;; Result: the result of execution of a single form
+;; Fragment: the combination of a form and result
+;; Listing: a block of traced Clojure code, e.g. an event handler function
+
+(defn event-code []
+  (let [code-traces      @(rf/subscribe [:code/current-code])
+        highlighted-form @(rf/subscribe [:code/highlighted-form])
+        debug?           @(rf/subscribe [:settings/debug?])]
+    [rc/v-box
+     :size "1 1 auto"
+     :class "code-panel"
+     :children
+     [(when debug? [:pre "Hover " (pr-str highlighted-form) "\n"])
+      (doall
+        (for [code-execution code-traces]
+          ^{:key (:id code-execution)}
+          [rc/v-box
+           :size "1 1 auto"
+           :gap "5px"
+           :children
+           (let [form       (:form code-execution)
+                 form-str   (zp/zprint-str form)
+                 search-str highlighted-form
+                 start      (str/index-of form-str search-str)
+                 length     (if (some? search-str)
+                              (count (pr-str search-str))
+                              0)
+                 before     (subs form-str 0 start)
+                 end-index  (+ start length)
+                 highlight  (subs form-str start end-index)
+                 after      (subs form-str end-index)]
+             [[:pre.code-listing
+               (list ^{:key "before"} before
+                     ^{:key "hl"} [:span.code-listing--highlighted highlight]
+                     ^{:key "after"} after)]
+              [:br]
+              [rc/v-box
+               :size "1 1 auto"
+               :style {:overflow-y "scroll"}
+               :children
+               (doall
+                 (->> (:code code-execution)
+                      ;; Remove traced function values, these are usually not very interesting in and of themselves.
+                      (remove (fn [line] (fn? (:result line))))
+                      (map-indexed
+                        (fn [i line]
+                          (list
+                            ;; See https://github.com/reagent-project/reagent/issues/350 for why we use random-uuid here
+                            ^{:key (random-uuid)}
+                            [rc/v-box
+                             :class "code-fragment"
+                             :style {:margin-left (str (* 9 (dec (:indent-level line))) "px")}
+                             :attr {:on-mouse-enter #(do (rf/dispatch [:code/hover-form (:form line)])
+                                                         true)
+                                    :on-mouse-leave #(do (rf/dispatch [:code/exit-hover-form (:form line)])
+                                                         true)}
+                             :children [[:pre (zp/zprint-str (:form line))]
+                                        ;; TODO: disable history expansion, or at least storing of it in ls.
+                                        [components/simple-render (:result line) [(:id code-execution) i]]]]
+                            ^{:key (random-uuid)}
+                            [rc/gap-f :size "5px"])))))]])]))]]))
+
+
 (defn render []
   (let [event-trace @(rf/subscribe [:epochs/current-event-trace])
         epoch-id    @(rf/subscribe [:epochs/current-match-state])]
@@ -48,7 +115,8 @@
     [rc/v-box
      :class "event-panel"
      :gap common/gs-19s
-     :children [[event-section "Coeffects" (get-in event-trace [:tags :coeffects])]
+     :children [[event-code]
+                [event-section "Coeffects" (get-in event-trace [:tags :coeffects])]
                 [event-section "Effects" (get-in event-trace [:tags :effects])]
                 [event-section "Interceptors" (get-in event-trace [:tags :interceptors])]
                 [rc/gap-f :size "0px"]]]))


prepared statements / values for insert/update/delete

--- src/er_cassandra/record/statement.clj
+++ src/er_cassandra/record/statement.clj
@@ -28,20 +28,12 @@
 (s/defn select-statement
   "returns a Hayt select statement"

-  ([table :- s/Keyword]
-   (select-statement table {}))
-
   ([table :- s/Keyword
     {:keys [limit columns] :as opts} :- sch/FullTableSelectOptsSchema]

    (h/select table
              (when columns (apply h/columns columns))
              (when limit (h/limit limit))))
-
-  ([table :- s/Keyword
-    key :- sch/KeySchema
-    record-or-key-value :- sch/RecordOrKeyValueSchema]
-   (select-statement table key record-or-key-value {}))

   ([table :- s/Keyword
     key :- sch/KeySchema
@@ -71,7 +63,7 @@
               [k (placeholder-kw prefix k)]))
        (into {})))

-(s/defn prepared-record-values
+(s/defn prepare-record-values
   "replace the keys in a record with the prepared-statement placeholders"
   [prefix record]
   (->> record
@@ -156,78 +148,173 @@

 (s/defn insert-statement
   "returns a Hayt insert statement"
-
-  ([table :- s/Keyword
-    record :- sch/RecordSchema] (insert-statement table record {}))
-
-  ([table :- s/Keyword
-    record :- sch/RecordSchema
-    {:keys [if-not-exists using] :as opts} :- sch/InsertOptsSchema]
-   (h/insert table
-             (h/values record)
-             (when if-not-exists (h/if-not-exists true))
-             (when (not-empty using) (apply h/using (flatten (seq using)))))))
-
+  [table :- s/Keyword
+   record :- sch/RecordSchema
+   {:keys [if-not-exists using] :as opts} :- sch/InsertOptsSchema]
+  (h/insert table
+            (h/values record)
+            (when if-not-exists (h/if-not-exists true))
+            (when (not-empty using) (apply h/using (flatten (seq using))))))
+
+(s/defn prepare-using-placeholders
+  [using-clauses]
+  (for [[k v] using-clauses]
+    [k (placeholder-kw :using k)]))
+
+(s/defn prepare-using-values
+  [using-clauses]
+  (->>
+   (for [[k v] using-clauses]
+     [(placeholder-kw :using k) v])
+   (into {})))

 (s/defn prepare-insert-statement
   "returns a Hayt prepared insert statement"
-  ([table :- s/Keyword
-    record :- sch/RecordSchema] (prepare-insert-statement table record {}))
-
-  ([table :- s/Keyword
-    record :- sch/RecordSchema
-    {:keys [if-not-exists using] :as opts} :- sch/InsertOptsSchema]
-   (let [insert-placeholders (prepare-record-placeholders :insert record)]
-
-     (h/insert table
-               (h/values insert-placeholders)
-               (when if-not-exists (h/if-not-exists true))
-               (when (not-empty using) (apply h/using (flatten (seq using))))))))
+  [table :- s/Keyword
+   record :- sch/RecordSchema
+   {:keys [if-not-exists using] :as opts} :- sch/InsertOptsSchema]
+  (let [insert-placeholders (prepare-record-placeholders :insert record)]
+
+    (h/insert table
+              (h/values insert-placeholders)
+              (when if-not-exists (h/if-not-exists true))
+              (when (not-empty using)
+                (apply h/using (flatten (prepare-using-placeholders using)))))))
+
+(s/defn prepare-insert-values
+  [table :- s/Keyword
+   record :- sch/RecordSchema
+   {:keys [if-not-exists using] :as opts} :- sch/InsertOptsSchema]
+  (let [insert-values (prepare-record-values :insert record)
+        using-values (prepare-using-values using)]
+    (merge insert-values
+           using-values)))

 (s/defn update-statement
   "returns a Hayt update statement"
-
-  ([table :- s/Keyword
-    key :- sch/KeySchema
-    record :- sch/RecordSchema] (update-statement table key record {}))
-
-  ([table :- s/Keyword
-    key :- sch/KeySchema
-    record :- sch/RecordSchema
-    {:keys [only-if
-            if-exists
-            if-not-exists
-            using
-            set-columns] :as opts} :- sch/UpdateOptsSchema]
-   (let [key-clause (extract-key-equality-clause key record opts)
-         set-cols (if (not-empty set-columns)
-                    (select-keys record set-columns)
-                    (apply dissoc record (flatten-key key)))
-
-         stmt (h/update table
-                        (h/set-columns set-cols)
-                        (h/where key-clause)
-                        (when only-if (h/only-if only-if))
-                        (when if-exists (h/if-exists true))
-                        (when if-not-exists (h/if-exists false))
-                        (when (not-empty using) (apply h/using (flatten (seq using)))))]
-     stmt)))
+  [table :- s/Keyword
+   key :- sch/KeySchema
+   record :- sch/RecordSchema
+   {:keys [only-if
+           if-exists
+           if-not-exists
+           using
+           set-columns] :as opts} :- sch/UpdateOptsSchema]
+  (let [key-clause (extract-key-equality-clause key record opts)
+        set-cols (if (not-empty set-columns)
+                   (select-keys record set-columns)
+                   (apply dissoc record (flatten-key key)))
+
+        stmt (h/update table
+                       (h/set-columns set-cols)
+                       (h/where key-clause)
+                       (when only-if (h/only-if only-if))
+                       (when if-exists (h/if-exists true))
+                       (when if-not-exists (h/if-exists false))
+                       (when (not-empty using) (apply h/using (flatten (seq using)))))]
+    stmt))
+
+(s/defn prepare-set-placeholders
+  [set-cols]
+  (->> set-cols
+       (map (fn [[k v]]
+              [k (placeholder-kw :set k)]))
+       (into {})))
+
+(s/defn prepare-set-values
+  [set-cols]
+  (->> set-cols
+       (map (fn [[k v]]
+              [(placeholder-kw :set k) v]))
+       (into {})))
+
+(s/defn prepare-update-statement
+  "returns a Hayt prepared update statement"
+  [table :- s/Keyword
+   key :- sch/KeySchema
+   record :- sch/RecordSchema
+   {:keys [only-if
+           if-exists
+           if-not-exists
+           using
+           set-columns] :as opts} :- sch/UpdateOptsSchema]
+  (let [key-clause (extract-key-equality-clause key record opts)
+        key-clause-placeholders (prepare-where-placeholders key-clause)
+        set-cols (if (not-empty set-columns)
+                   (select-keys record set-columns)
+                   (apply dissoc record (flatten-key key)))
+        set-placeholders (prepare-set-placeholders set-cols)
+
+        stmt (h/update table
+                       (h/set-columns set-placeholders)
+                       (h/where key-clause-placeholders)
+                       (when only-if (h/only-if only-if))
+                       (when if-exists (h/if-exists true))
+                       (when if-not-exists (h/if-exists false))
+                       (when (not-empty using)
+                         (apply h/using
+                                (flatten (prepare-using-placeholders using)))))]
+    stmt))
+
+(s/defn prepare-update-values
+  [table :- s/Keyword
+   key :- sch/KeySchema
+   record :- sch/RecordSchema
+   {:keys [only-if
+           if-exists
+           if-not-exists
+           using
+           set-columns] :as opts} :- sch/UpdateOptsSchema]
+  (let [key-clause (extract-key-equality-clause key record opts)
+        key-clause-values (prepare-where-values key-clause)
+        set-cols (if (not-empty set-columns)
+                   (select-keys record set-columns)
+                   (apply dissoc record (flatten-key key)))
+        set-values (prepare-set-values set-cols)
+        using-values (prepare-using-values using)]
+    (merge
+     key-clause-values
+     set-values
+     using-values)))

 (s/defn delete-statement
   "returns a Hayt delete statement"
-
-  ([table :- s/Keyword
-    key :- sch/KeySchema
-    record-or-key-value :- sch/RecordOrKeyValueSchema]
-   (delete-statement table key record-or-key-value {}))
-
-  ([table :- s/Keyword
-    key :- sch/KeySchema
-    record-or-key-value :- sch/RecordOrKeyValueSchema
-    {:keys [only-if if-exists using where] :as opts} :- sch/DeleteOptsSchema]
-   (let [key-clause (extract-key-equality-clause key record-or-key-value opts)]
-     (h/delete table
-               (h/where (combine-where key-clause where))
-               (when only-if (h/only-if only-if))
-               (when if-exists (h/if-exists true))
-               (when (not-empty using) (apply h/using (flatten (seq using))))))))
+  [table :- s/Keyword
+   key :- sch/KeySchema
+   record-or-key-value :- sch/RecordOrKeyValueSchema
+   {:keys [only-if if-exists using where] :as opts} :- sch/DeleteOptsSchema]
+  (let [key-clause (extract-key-equality-clause key record-or-key-value opts)]
+    (h/delete table
+              (h/where (combine-where key-clause where))
+              (when only-if (h/only-if only-if))
+              (when if-exists (h/if-exists true))
+              (when (not-empty using) (apply h/using (flatten (seq using)))))))
+
+(s/defn prepare-delete-statement
+  [table :- s/Keyword
+   key :- sch/KeySchema
+   record-or-key-value :- sch/RecordOrKeyValueSchema
+   {:keys [only-if if-exists using where] :as opts} :- sch/DeleteOptsSchema]
+  (let [key-clause (extract-key-equality-clause key record-or-key-value opts)
+        where-clause (combine-where key-clause where)
+        where-placeholders (prepare-where-placeholders where-clause)
+        using-placeholders (prepare-using-placeholders using)]
+    (h/delete table
+              (h/where where-placeholders)
+              (when only-if (h/only-if only-if))
+              (when if-exists (h/if-exists true))
+              (when (not-empty using)
+                (apply h/using (flatten using-placeholders))))))
+
+(s/defn prepare-delete-values
+  [table :- s/Keyword
+   key :- sch/KeySchema
+   record-or-key-value :- sch/RecordOrKeyValueSchema
+   {:keys [only-if if-exists using where] :as opts} :- sch/DeleteOptsSchema]
+  (let [key-clause (extract-key-equality-clause key record-or-key-value opts)
+        where-clause (combine-where key-clause where)
+        where-values (prepare-where-values where-clause)
+        using-values (prepare-using-values using)]
+    (merge
+     where-values
+     using-values)))


[WM] install server & service ns'es instead of core

--- src/leiningen/new/kraken_http_api.clj
+++ src/leiningen/new/kraken_http_api.clj
@@ -34,7 +34,8 @@

              ["resources/config.edn" (render "config.edn" data)]

-             ["src/{{sanitized}}/core.clj" (render "core.clj" data)]
+             ["src/{{sanitized}}/server.clj" (render "server.clj" data)]
+             ["src/{{sanitized}}/service.clj" (render "service.clj" data)]
              ["src/{{sanitized}}/queue.clj" (render "queue.clj" data)]
              ["src/{{sanitized}}/channels.clj" (render "channels.clj" data)]
              ["src/{{sanitized}}/handlers.clj" (render "handlers.clj" data)]


Add lein/pom function

Add lein/pom function

--- src/leiningen/pallet_release/lein.clj
+++ src/leiningen/pallet_release/lein.clj
@@ -61,3 +61,8 @@
   [project]
   (debug "lein deploy")
   (task project "deploy" "clojars"))
+
+(defn pom
+  [project]
+  (debug "lein pom")
+  (task project "pom"))


+TODO

+TODO

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -203,6 +203,9 @@
                                       (filter (fn [lexeme]
                                                 (and (not (fail? (unifyc (strip-refs (get-in lexeme [:synsem] :top))
                                                                          (strip-refs bolt-child-synsem))))
+                                                     ;; TODO: language-specific: allow
+                                                     ;; some way to have this optimization be expressed
+                                                     ;; in a language-specific way.
                                                      (not (fail? (unifyc (strip-refs (get-in lexeme [:italiano] :top))
                                                                          (strip-refs bolt-child-italiano))))))
                                               complement-candidate-lexemes))]


more about merging

more about merging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -158,28 +158,29 @@
                                  (+ 1 depth)
                                  max-depth
                                  top-bolt)))))))
+
 (defn generate2
   "Return all expressions matching spec _spec_ given the model _model_."
   [spec model]
   (log/debug (str "generate2: spec: " spec))
   (mapfn #(do-defaults % model)
          (flatten
-          (mapfn (fn [bolt]
-                   (let [comp-paths (find-comp-paths bolt)
+          (mapfn (fn [bolt-at]
+                   (let [comp-paths (find-comp-paths bolt-at)
                          comp-bolts
-                         (map #(comp-path-to-bolts bolt % model 0 max-total-depth)
+                         (map #(comp-path-to-bolts bolt-at % model 0 max-total-depth)
                               comp-paths)]
                      ;; filter by the following constraint:
                      ;; that for every path that points to a complement of a bolt,
                      ;; there is a non-empty set of bolts that satisfies
                      ;; that complement's path.
                      (when (not (some empty? comp-bolts))
-                       (add-comps bolt
+                       (add-comps bolt-at
                                   model
                                   comp-paths
                                   comp-bolts
                                   0 max-total-depth
-                                  bolt))))
+                                  bolt-at))))
                  (lightning-bolts model spec 0 max-total-depth)))))

 (defn generate-n


cleanup

cleanup

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -56,20 +56,16 @@

 (defn mapping [spec model depth max-depth]
   (map (fn [lb]
-         (create-mapping
-          lb (find-comp-paths lb)
-          model 0 6))
+         (merge
+          (let [comp-paths (find-comp-paths lb)]
+            (zipmap comp-paths
+                    (map (fn [path]
+                           (comp-path-to-bolts
+                             lb path model depth max-depth))
+                         comp-paths)))
+          {[]
+           (lazy-seq [lb])}))
        (lightning-bolts model spec depth max-depth)))
-
-(defn create-mapping [bolt comp-paths model depth max-depth]
-  (merge
-   (zipmap comp-paths
-           (map (fn [path]
-                  (comp-path-to-bolts
-                   bolt path model depth max-depth))
-                comp-paths))
-   {[]
-    (lazy-seq [bolt])}))

 (defn comp-path-to-bolts
   "return a lazy sequence of bolts for all possible complements that can be added to the end of the _path_ within _bolt_."


s/info/debug/

s/info/debug/

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -123,7 +123,7 @@
                      (log/debug (str "lightning-bolts: (optimizeme) size of subset of candidate heads: " (count subset) " with spec: " (strip-refs spec) " and parent:  " (get-in parent [:rule])))
                      (let [result (over/overh parent (lazy-shuffle subset))]
                        (log/debug (str "lightning-bolts: (optimizeme) surviving candidate heads: " (count result)))
-                       (log/info (str "trying overh with spec: " (strip-refs spec)))
+                       (log/debug (str "trying overh with spec: " (strip-refs spec)))
                        (if (and (not (empty? subset)) (empty? result)
                                 (> (count subset)
                                    10))


sns: improve test organization: extract fake args, make aws region configurable

--- test/riemann/test/sns.clj
+++ test/riemann/test/sns.clj
@@ -4,9 +4,21 @@
         riemann.sns
         clojure.test))

-(def access-key-id     (System/getenv "AWS_ACCESS_KEY_ID"))
-(def secret-access-key (System/getenv "AWS_SECRET_ACCESS_KEY"))
-(def arn               (System/getenv "AWS_SNS_TOPIC"))
+(def env-access-key-id     (System/getenv "AWS_ACCESS_KEY_ID"))
+(def env-secret-access-key (System/getenv "AWS_SECRET_ACCESS_KEY"))
+(def env-region            (System/getenv "AWS_REGION"))
+(def env-arn               (System/getenv "AWS_SNS_TOPIC"))
+(def fake-aws-opts {:access-key "access-key" :secret-key "secret-key" :region :ap-north})
+(def fake-event {:host "localhost"
+                 :service "sns test"
+                 :state "ok"
+                 :description "all clear, uh, situation normal"
+                 :metric 2.71828
+                 :time 0})
+(def fake-event-subject "localhost sns test ok")
+(def fake-event-body (str "At "
+                          (time-at 0)
+                          "\nlocalhost sns test ok (2.71828)\nTags: []\n\nall clear, uh, situation normal"))

 (deftest override-formatting-test
   (let [a (promise)]
@@ -30,39 +42,25 @@

 (deftest sns-publisher-test
   (let [a (promise)
-        sns (sns-publisher {:access-key "riemann-test"
-                            :secret-key "secret"
-                            :region :ap-north})
+        sns (sns-publisher fake-aws-opts)
         stream (sns "test:arn")]
     (with-redefs [clj-aws.sns/publish #(deliver a [%2 %3 %4])]
-      (stream {:host "localhost"
-               :service "sns test"
-               :state "ok"
-               :description "all clear, uh, situation normal"
-               :metric 2.71828
-               :time 0}))
-    (is (= @a [
-               "test:arn"
-               "localhost sns test ok"
-               (str "At "
-                    (time-at 0)
-                    "\nlocalhost sns test ok (2.71828)\nTags: []\n\nall clear, uh, situation normal")]))))
+      (stream fake-event))
+    (is (= @a ["test:arn" fake-event-subject fake-event-body]))))

 (deftest ^:sns ^:integration sns-test
-  (when-not access-key-id
+  (when-not env-access-key-id
     (println "export AWS_ACCESS_KEY_ID=\"...\" to run :sns tests."))
-  (when-not secret-access-key
+  (when-not env-secret-access-key
     (println "export AWS_SECRET_ACCESS_KEY=\"...\" to run :sns tests."))
-  (when-not arn
+  (when-not env-region
+    (println "export AWS_REGION=\"...\" to run :sns tests."))
+  (when-not env-arn
     (println "export AWS_SNS_TOPIC=\"...\" to run :sns tests."))

-  (let [sns (sns-publisher {:access-key access-key-id
-                            :secret-key secret-access-key
-                            :region :ap-north})
-        stream (sns arn)]
-    (stream {:host "localhost"
-             :service "sns test"
-             :state "ok"
-             :description "all clear, uh, situation normal"
-             :metric 3.14159
-             :time (unix-time)})))
+  (let [sns (sns-publisher {:access-key env-access-key-id
+                            :secret-key env-secret-access-key
+                            :region env-region})
+        stream (sns env-arn)
+        event (merge fake-event {:time (unix-time)})]
+    (stream event)))


Fonts served on https now

Fonts served on https now

--- src/briefcase/views.clj
+++ src/briefcase/views.clj
@@ -189,7 +189,7 @@
      [:meta { :content "IE=edge,chrome=1" :http-equiv "X-UA-Compatible" }]
      [:meta { :name "viewport" :content "width=device-width, user-scalable=no" }]
      [:meta { :name "description" :content title}]
-     [:link { :href "http://fonts.googleapis.com/css?family=Merriweather:400,700|Open+Sans:400,700" :rel "stylesheet" :type "text/css" }]
+     [:link { :href "https://fonts.googleapis.com/css?family=Merriweather:400,700|Open+Sans:400,700" :rel "stylesheet" :type "text/css" }]
      (bundles/link-to-css-bundles request  ["styles.css"])
      [:title title]]
     [:body


add tests for common core/validation use cases

--- test/themis/core_test.clj
+++ test/themis/core_test.clj
@@ -1,35 +1,81 @@
 (ns themis.core-test
-  (:require [themis.core :as core]
+  (:require [themis.core :refer [validation pvalidation] :as core]
             [themis.predicates :as preds]
-            [themis.validators :refer [from-predicate presence]]
+            [themis.validators :refer [from-predicate] :as validators]
             [clojure.test :refer :all]))

-(deftest simple-tests
-  (let [alice {:name "Alice"}
-        alice-rules [[[:name]
-                      (fn [_payload value opts]
-                        (when (not= value "Alice")
-                          {:error ":name not Alice"}))]]]
-    (testing "Alice's name should be Alice."
-      (is (= (core/validation alice alice-rules) {[:name] nil})))
-    (testing "Bob's name should not be Alice."
-      (is (not= (core/validation {:name "Bob"} alice-rules) {[:name] nil})))))
+(def paul {:name {:first "Paul", :last "deGrandis"}
+           :has-pet true
+           :pets ["walter"]})

-(deftest paul-tests
-  "These are selected tests are ported from Paul DeGrandis' comment tests."
-  (let [paul {:name {:first "Paul", :last "deGrandis"}
-              :has-pet true
-              :pets ["walter"]}
-        paul-rules [[[:name :first]
-                     [[presence {:response {:text "First name is not there"}}]
-                                     (fn [t-map data-point opt-map](Thread/sleep 500)(and (= data-point "Paul")
-                                                                                {:a 1 :b 2}))]]
-                    [[:pets 0]
-                     [(from-predicate preds/longer-than? 20 "Too short; Needs to be longer than 20")]]]
-        paul-expected-validation {[:name :first] '(nil  {:a 1, :b 2}), [:pets 0] "Too short; Needs to be longer than 20"}]
-    (testing "Does validation work on paul-rules?"
-      (is (= (core/validation paul paul-rules)
-             paul-expected-validation)))
-    (testing "Does pvalidation work on paul-rules?"
-      (is (= (core/pvalidation paul paul-rules)
-             paul-expected-validation)))))
+(defn degrandis-pets [t-map data-point opt-map]
+  (when-not (and (= (get-in t-map [:name :last]) "deGrandis")
+                 (:has-pet t-map))
+    :no-degrandis-pets-found))
+
+(def paul-rules
+  [[[:name :first] [[validators/presence {:response {:text "First name is not there"}}]
+                    (fn [t-map data-point opt-map]
+                      (and (= data-point "Paul")
+                           {:error "You are Paul!"}))]]
+   ;; Rules that don't match a specific key validate the whole map
+   [:* degrandis-pets]])
+
+(deftest validation-general
+  (testing "validation fns return nil or false when validations pass"
+    (is (= (validation (assoc-in paul [:name :first] "Bob") paul-rules)
+          {[:*] nil, [:name :first] '(nil false)})))
+  (testing "validation fns return truish values containing error info when validations fail"
+    (is (= (validation (assoc paul :has-pet false) paul-rules)
+          {[:*] :no-degrandis-pets-found, [:name :first] '(nil {:error "You are Paul!"})})))
+  (testing "rules that validate the whole map can be any name"
+    (is (= (get (validation (assoc paul :has-pet false) paul-rules) [:*])
+           (get (validation (assoc paul :has-pet false) (assoc paul-rules 1 [:multi_ degrandis-pets])) [:multi_])
+          :no-degrandis-pets-found)))
+  (testing "pvalidation and validation should validate the same"
+    (is (= (validation (assoc paul :has-pet false) paul-rules)
+           (pvalidation (assoc paul :has-pet false) paul-rules)))))
+
+(deftest validation-with-different-coordinates
+  (testing "a keyword coordinate"
+    (is (= (validation {:pets {}} [[:pets [(from-predicate vector? :error)]]])
+           {[:pets] :error})))
+  (testing "a vector coordinate"
+    (is (= (validation {:pets {}} [[[:pets] [(from-predicate vector? :error)]]])
+           {[:pets] :error})))
+  (testing "a vector coordinate that gets in a vector"
+    (is (= (validation {:pets ["Rex"]} [[[:pets 0] [(from-predicate preds/longer-than? 20 :error)]]])
+           {[:pets 0] :error})))
+  (testing "a vector coordinate that gets in a map"
+    (is (= (validation {:pets {:rex "Rex Mister"}} [[[:pets :rex] [(from-predicate preds/longer-than? 20 :error)]]])
+           {[:pets :rex] :error}))))
+
+(def name-present (from-predicate seq :not-present))
+(def name-long-enough
+  (fn [_ data-point opts]
+    (when-not (> (count (seq data-point)) 10)
+      (or (:error opts) :too-short))))
+
+(deftest validation-with-different-validation-invocations
+  (testing "a single fn"
+    (is (= (validation {:name nil} [[:name name-present]])
+           {[:name] :not-present})))
+  (testing "an inline fn"
+    (is (= (validation {:name nil} [[:name (from-predicate seq :not-present)]])
+           {[:name] :not-present})))
+  (testing "a vector with single fn"
+    (is (= (validation {:name nil} [[:name [name-present]]])
+           {[:name] :not-present})))
+  (testing "a vector with multiple fns calls all validations"
+    (is (= (validation {:name nil} [[:name [name-present name-long-enough]]])
+           {[:name] '(:not-present :too-short)})))
+  (testing "a symbol fn"
+    (is (= (validation {:name nil} [[:name `name-present]])
+           {[:name] :not-present})))
+  (testing "a fn with options"
+    (is (= (validation {:name nil} [[:name [[name-long-enough {:error :code_105}]]]])
+           {[:name] :code_105})))
+  (testing "a keyword fn"
+    (is (= (validation {:name nil} [[:name ::name-present]])
+           {[:name] :not-present}))))
+


Fix vote DB operation.

Fix vote DB operation.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -173,13 +173,28 @@
         update (db-common/with-timeout db-common/default-timeout
                   (-> (r/table table-name)
                       (r/get entry-uuid)
-                      (r/update
-                       (r/fn [entry-doc]
-                        {:polls {poll-uuid {:replies {reply-id {:votes
-                         (-> entry-doc
-                          (r/get-field [:polls poll-uuid :replies reply-id :votes])
-                          (r/default [])
-                          (set-operation user-id-value))}}}}}))
+                      (r/update (r/fn [entry]
+                       {:polls {poll-uuid {:replies
+                        (-> entry
+                         (r/get-field [:polls poll-uuid :replies])
+                         (r/values)
+                         (r/map (r/fn [reply-data]
+                          (r/branch
+                           (r/eq (r/get-field reply-data [:reply-id]) reply-id)
+                           (r/object (r/get-field reply-data :reply-id)
+                            (r/merge reply-data
+                             {:votes (-> reply-data
+                                      (r/get-field [:votes])
+                                      (r/default [])
+                                      (set-operation user-id-value))}))
+                           (r/object (r/get-field reply-data :reply-id)
+                            (r/merge reply-data
+                             {:votes (-> reply-data
+                                      (r/get-field [:votes])
+                                      (r/default [])
+                                      (r/set-difference [user-id]))})))))
+                         (r/reduce (r/fn [a b]
+                          (r/merge a b))))}}}))
                       (r/run conn)))]
     (if (or (= 1 (:replaced update)) (= 1 (:unchanged update)))
       (db-common/read-resource conn table-name entry-uuid)


Switch back to maintaining low-water-mark but allow barriers below the low-water-mark to be read by other peers

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -376,23 +376,16 @@
 ;; 1. Low water mark = High water mark
 ;; 2. High watermark does not exist. Stream observer needs to catch up.

-(defn calculate-ticket [{:keys [ticket high-water-mark barriers barrier-index] :as watermarks} my-peer-id take-n]
-  (let [low-water-mark (or (second ticket) -1)]
+(defn calculate-ticket [{:keys [ticket low-water-mark high-water-mark barriers barrier-index] :as watermarks} my-peer-id take-n]
+  (let [low-water-mark (or low-water-mark -1)]
     (if (or (not high-water-mark) (= low-water-mark high-water-mark))
       -1
       (let [barriers* (unseen-barriers barriers my-peer-id)
             nearest-barrier (first (sort (keys barriers*)))
             nearest-barrier-pos (get barrier-index nearest-barrier high-water-mark)
-            new-low (inc low-water-mark)
-            new-high (+ new-low (dec take-n))
-            result
-            (cond (> new-high high-water-mark)
-                  [new-low high-water-mark]
-
-                  (< nearest-barrier-pos new-high)
-                  [new-low nearest-barrier-pos]
-
-                  :else [new-low new-high])]
+            new-low (min (inc low-water-mark) nearest-barrier-pos)
+            new-high (min (+ new-low (dec take-n)) nearest-barrier-pos)
+            result [new-low new-high]]
         (when nearest-barrier
           (assert (>= nearest-barrier-pos (first result))
                   {:msg "Next barrier is behind the lower ticket bound"
@@ -408,9 +401,9 @@
 (defn take-ticket [global-watermarks task-id src-peer-id peer-id take-n]
   (let [ticket (calculate-ticket (get-in global-watermarks [task-id src-peer-id]) peer-id take-n)]
     (if (= -1 ticket)
-      (assoc-in global-watermarks [task-id src-peer-id :new-ticket?] false)
+      (assoc-in global-watermarks [task-id src-peer-id :ticket] ticket)
       (-> global-watermarks
-          (assoc-in [task-id src-peer-id :new-ticket?] true)
+          (assoc-in [task-id src-peer-id :low-water-mark] (max (second ticket) (or -1 (:low-water-mark global-watermarks))))
           (assoc-in [task-id src-peer-id :ticket] ticket)))))

 (defn task-alive? [event]
@@ -428,16 +421,17 @@
       (let [{:keys [subscription src-peer-id]} next-subscription
             result-state (atom [])
             take-n 2
-            gw-val (swap! global-watermarks take-ticket task-id src-peer-id id take-n)]
-        (if (get-in gw-val [task-id src-peer-id :new-ticket?])
-          (let [ticket (get-in gw-val [task-id src-peer-id :ticket])
-                fh (controlled-fragment-data-handler (partial handle-message result-state message-counter task-id src-peer-id ticket))
-                expected-messages (inc (- (second ticket) (first ticket)))]
+            gw-val (swap! global-watermarks take-ticket task-id src-peer-id id take-n)
+            ticket (get-in gw-val [task-id src-peer-id :ticket])]
+        (if (= -1 ticket)
+          []
+          (let [fh (controlled-fragment-data-handler (partial handle-message result-state message-counter task-id src-peer-id ticket))
+                [low high] ticket
+                expected-messages (inc (- high low))]
             (while (and (< (count @result-state) expected-messages)
                         (task-alive? event))
               (.controlledPoll ^Subscription subscription ^ControlledFragmentHandler fh fragment-limit-receiver))
-            @result-state)
-          []))
+            @result-state)))
       [])))

 (defn get-publication [publications channel stream-id]


move function

move function

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -775,6 +775,16 @@
                 (lightning-bolts retval
                                  spec
                                  0 depth)}))})))
+
+(defn model-with-lexicon [input-lexicon filter-lexicon-fn model]
+  (let [input-lexicon (vocab-entry-to-lexeme input-lexicon)
+        synthetic-noun (edn2lexicon input-lexicon)
+        new-lexicon (merge-with concat
+                                synthetic-noun
+                                (filtered-lexicon
+                                 (:lexicon model)
+                                 filter-lexicon-fn))]
+    (model-plus-lexicon new-lexicon)))

 (defn model-reloaded []
   (log/info (str "reloading model by compiling lexicon sources..."))
@@ -941,16 +951,3 @@
                                   model)
          (generation-implications spec (rest reflexive-constraints) model)))
      spec)))
-
-(defn model-with-lexicon [input-lexicon filter-lexicon-fn model]
-  ;; TODO: move this processing into (babel.italiano.lexicon/edn2lexicon)
-  (let [input-lexicon (vocab-entry-to-lexeme input-lexicon)
-        synthetic-noun (edn2lexicon input-lexicon)
-        filter-lexicon-fn #(= :det (get-in % [:synsem :cat]))
-        new-lexicon
-        (merge-with concat
-                    synthetic-noun
-                    (filtered-lexicon
-                     (:lexicon model)
-                     filter-lexicon-fn))]
-    (model-plus-lexicon new-lexicon)))


add indices to np-grammar

add indices to np-grammar

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -809,30 +809,30 @@
 (defn np-grammar []
   (deliver-lexicon)
   (let [lexicon @lexicon
-          grammar
-          (filter #(or (= (:rule %) "noun-phrase1")
-                       (= (:rule %) "noun-phrase2")
-                       (= (:rule %) "nbar1")
-                       (= (:rule %) "nbar2"))
-                  grammar)
-          rules (map #(keyword (get-in % [:rule])) grammar)
-          lexicon
-          (into {}
-                (for [[k v] lexicon]
-                  (let [filtered-v
-                        (filter #(and (not (= true (get-in % [:top])))
-                                      (or (= (get-in % [:synsem :cat] :adjective) :adjective)
-                                          (= (get-in % [:synsem :cat] :det) :det)
-                                          (and (= (get-in % [:synsem :cat] :noun) :noun)
-                                               (not (= (get-in % [:synsem :propernoun] false) true))
-                                               (not (= (get-in % [:synsem :pronoun] false) true)))))
-                                v)
-                        ;; TODO: remove this removal:
-                        ;; don't remove this semantic info. It's an interesting example of how to
-                        ;; process a lexicon, though, so perhaps find a reason to use it in some way.
+        grammar
+        (filter #(or (= (:rule %) "noun-phrase1")
+                     (= (:rule %) "noun-phrase2")
+                     (= (:rule %) "nbar1")
+                     (= (:rule %) "nbar2"))
+                grammar)
+        rules (map #(keyword (get-in % [:rule])) grammar)
+        lexicon
+        (into {}
+              (for [[k v] lexicon]
+                (let [filtered-v
+                      (filter #(and (not (= true (get-in % [:top])))
+                                    (or (= (get-in % [:synsem :cat] :adjective) :adjective)
+                                        (= (get-in % [:synsem :cat] :det) :det)
+                                        (and (= (get-in % [:synsem :cat] :noun) :noun)
+                                             (not (= (get-in % [:synsem :propernoun] false) true))
+                                             (not (= (get-in % [:synsem :pronoun] false) true)))))
+                              v)
+                      ;; TODO: remove this removal:
+                      ;; don't remove this semantic info. It's an interesting example of how to
+                      ;; process a lexicon, though, so perhaps find a reason to use it in some way.
                       remove-semantic-features
-                        (map (fn [lexeme]
-                               (remove-matching-keys lexeme
+                      (map (fn [lexeme]
+                             (remove-matching-keys lexeme
                                                      #(or
                                                        (= % :activity)        (= % :animate)  (= % :artifact)
                                                        (= % :buyable)         (= % :child)    (= % :clothing)
@@ -841,25 +841,28 @@
                                                        (= % :human)           (= % :legible)  (= % :part-of-human-body)
                                                        (= % :pet)
                                                        (= % :physical-object) (= % :place)    (= % :speakable))))
-                             filtered-v)]
-                    (if (not (empty? remove-semantic-features))
-                      [k remove-semantic-features]))))
-          lexicon-for-generation (lexicon-for-generation lexicon)]
-      {:name "np-grammar"
-       :morph-walk-tree (fn [tree]
-                          (do
-                            (merge tree
-                                   (morph-walk-tree tree))))
-       :language "it"
-       :language-keyword :italiano
-       :morph-ps fo-ps
-       :morph fo
-       :lookup (fn [arg]
-                 (analyze arg lexicon))
-       :generate {:lexicon lexicon-for-generation}
-       :grammar grammar
-       :lexicon lexicon
-       :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
-       :rules rules
-       :rule-map (zipmap rules grammar)}))
-
+                           filtered-v)]
+                  (if (not (empty? remove-semantic-features))
+                    [k remove-semantic-features]))))
+        lexicon-for-generation (lexicon-for-generation lexicon)
+        ;; indices from paths to subsets of the lexicon
+        indices (create-indices lexicon-for-generation index-lexicon-on-paths)]
+    {:index-fn (fn [spec] (lookup-spec spec indices index-lexicon-on-paths))
+     :name "np-grammar"
+     :morph-walk-tree (fn [tree]
+                        (do
+                          (merge tree
+                                 (morph-walk-tree tree))))
+     :language "it"
+     :language-keyword :italiano
+     :morph-ps fo-ps
+     :morph fo
+     :lookup (fn [arg]
+               (analyze arg lexicon))
+     :generate {:lexicon lexicon-for-generation}
+     :grammar grammar
+     :lexicon lexicon
+     :lexical-cache (atom (cache/fifo-cache-factory {} :threshold 1024))
+     :rules rules
+     :rule-map (zipmap rules grammar)}))
+


reorder args

reorder args

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -502,10 +502,6 @@
    "cantare" {:synsem {:cat :verb
                        :sem {:pred :sing
                              :subj {:human true}}}}
-
-   "caricare" {:italiano {:future-stem "caricher"}
-               :synsem {:cat :verb
-                        :sem {:pred :caricare}}}
    "camicia"
     (unify agreement-noun
            common-noun
@@ -538,16 +534,19 @@
              :synsem {:cat :verb
                       :sem {:pred :understand}}}

+   "caricare" {:italiano {:future-stem "caricher"}
+               :synsem {:cat :verb
+                        :sem {:pred :caricare}}}
    "casa"
-    (unify agreement-noun
-           common-noun
-           countable-noun
-           feminine-noun
-           {:synsem {:sem {:pred :casa
-                           :activity false ;; should not need this probably: should be inferrable from  :place==true or perhaps :artifact==true.
-                           :buyable true
-                           :artifact true
-                           :place true}}})
+   (unify agreement-noun
+          common-noun
+          countable-noun
+          feminine-noun
+          {:synsem {:sem {:pred :casa
+                          :activity false ;; should not need this probably: should be inferrable from  :place==true or perhaps :artifact==true.
+                          :buyable true
+                          :artifact true
+                          :place true}}})

     "cattivo"
      (unify adjective


use {:agr {:number/:gender}}, not {:number/:gender} for determiners

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -123,9 +123,10 @@
    "aggiungere" {:synsem {:cat :verb
                           :sem {:pred :add}}}
    "aiutare"
-    {:synsem {:essere false
-              :sem {:pred :aiutare
-                    :activity true
+   {:synsem {:cat :verb
+             :essere false
+             :sem {:pred :aiutare
+                   :activity true
                     :obj {:human true}}}}
    "alto"
    [;; non-comparative:
@@ -653,17 +654,19 @@
                    (merge common
                           {:synsem {:cat :verb
                                     :sem {:pred :strike}}})])
-      "cominciare"
-      [{:synsem {:essere false
-                          :sem {:activity true
-                                :discrete false
-                                :pred :begin
-                                :subj {:animate true}}}}
-       {:synsem {:essere false
-                 :sem {:activity true
-                       :discrete false
-                       :pred :start
-                       :subj {:animate true}}}}]
+   "cominciare"
+   [{:synsem {:cat :verb
+              :essere false
+              :sem {:activity true
+                    :discrete false
+                    :pred :begin
+                    :subj {:animate true}}}}
+    {:synsem {:cat :verb
+              :essere false
+              :sem {:activity true
+                    :discrete false
+                    :pred :start
+                    :subj {:animate true}}}}]
       "compito"
       (unify agreement-noun
              common-noun
@@ -784,19 +787,21 @@
       "dei"
       {:synsem {:cat :det
                 :def :partitivo
-                :number :plur
-                :gender :masc}}
+                :agr {:gender :masc
+                      :number :plur}}}

       "delle"
       {:synsem {:cat :det
                 :def :partitivo
                 :number :plur
-                :gender :fem}}
+                :agr {:gender :fem
+                      :number :plur}}}

       "deludere"
        {:italiano {:passato "deluso"}
-        :synsem {:essere false
+        :synsem {:cat :verb
+                 :essere false
                  :sem {:deliberate false
                        :discrete true
                        :activity false
@@ -826,22 +831,22 @@
       "di la"
       {:synsem {:cat :det
                 :def :partitivo
-                :number :sing
-                :mass true
-                :gender :fem}}
+                :agr {:gender :fem
+                      :number :sing}
+                :mass true}}

       "di le"
       {:synsem {:cat :det
                 :def :partitivo
-                :number :plur
-                :gender :fem}}
+                :agr {:gender :fem
+                      :number :plur}}}

       "di il"
       {:synsem {:cat :det
                 :def :partitivo
-                :number :sing
-                :mass true
-                :gender :masc}}
+                :agr {:gender :masc
+                      :number :sing}
+                :mass true}}

       "difficile"
       ;; non-comparative
@@ -1165,16 +1170,14 @@
       (unify determiner
              {:synsem {:cat :det
                        :def :def
-                       :gender :masc
-                       :number :plur}})
-
-
+                       :agr {:gender :masc
+                             :number :plur}}})
       "il"
       (unify determiner
               {:synsem {:cat :det
                         :def :def
-                        :gender :masc
-                        :number :sing}})
+                        :agr {:number :sing
+                              :gender :masc}}})

       "imparare"  {:synsem {:cat :verb
                             :sem {:pred :learn}}}
@@ -1261,30 +1264,30 @@
        ;; 3. article
        {:synsem {:cat :det
                  :def :def
-                 :gender :fem
-                 :number :sing}}]
-
+                 :agr {:gender :fem
+                       :number :sing}}}]
       "la loro"
       {:synsem {:cat :det
                 :def :possessive
-                :gender :fem
-                :number :sing
+                :agr {:gender :fem
+                      :number :sing}
                 :sem {:number :plur
                       :person :3rd}}}

       "la mia"
       {:synsem {:cat :det
                 :def :possessive
-                :gender :fem
-                :number :sing
+                :agr {:gender :fem
+                      :number :sing}
                 :sem {:number :sing
                       :person :1st}}}

       "la nostra"
       {:synsem {:cat :det
                 :def :possessive
-                :gender :fem
                 :number :sing
+                :agr {:gender :fem
+                      :number :sing}
                 :sem {:number :plur
                       :person :1st}}}

@@ -1293,25 +1296,27 @@
    "la sua"
    {:synsem {:cat :det
              :def :possessive
-             :gender :fem
+             :agr {:gender :fem
+                   :number :sing}
              :number :sing
              :sem {:number :sing
                    :person :3rd}}}
    "la tua"
    [{:synsem {:cat :det
               :def :possessive
-              :gender :fem
+              :agr {:gender :fem
+                    :number :sing}
               :number :sing
               :sem {:number :sing
                     :person :2nd}}}
-
-    {:synsem {:cat :det
+    {:synsem {:cat :noun
+              :pronoun true
               :def :possessive
-              :gender :fem
-              :number :sing
-                :sem {:number :plur
-                      :person :2nd}}}]
-
+              :agr {:gender :fem
+                    :number :sing}
+              :sem {:number :sing
+                    :person :2nd}}}]
+
    "lavarsi" (let [subject-semantics (atom :top)
                    subject-agr (atom :top)]
               {:synsem {:cat :verb
@@ -1333,8 +1338,8 @@
    "le"
    {:synsem {:cat :det
              :def :def
-             :gender :fem
-             :number :plur}}
+             :agr {:gender :fem
+                   :number :plur}}}
    "lei"
    (let [common {:synsem {:cat :noun
                           :pronoun true
@@ -1637,11 +1642,11 @@
                                :2plur "potete"
                                :3plur "possono"}}}]
      [(merge shared-part-of-potere
-             {:synsem {:pred :can}})
+             {:synsem {:sem {:pred :can}}})
       (merge shared-part-of-potere
-             {:synsem {:pred :may}})
+             {:synsem {:sem {:pred :may}}})
       (merge shared-part-of-potere
-             {:synsem {:pred :be-able-to}})])
+             {:synsem {:sem {:pred :be-able-to}}})])

    "prendere" {:synsem {:cat :verb :sem {:pred :grab}}
                :italiano {:passato "preso"}}
@@ -1666,7 +1671,7 @@
    {:synsem {:cat :det
              :def :indef
              :mass false
-             :number :sing}}
+             :agr {:number :sing}}}

    "racontare" {:synsem {:cat :verb
                          :sem {:pred :recount}}}
@@ -1921,17 +1926,17 @@
               :subcat '()}}]

    "un"
-   [{:synsem {:cat :det
-              :def :indef
-              :mass false
-              :gender :masc
-              :number :sing}}]
+   {:synsem {:cat :det
+             :def :indef
+             :mass false
+             :agr {:number :sing
+                   :gender :masc}}}
    "una"
-   [{:synsem {:cat :det
-              :def :indef
-              :mass false
-              :gender :fem
-              :number :sing}}]
+   {:synsem {:cat :det
+             :def :indef
+             :mass false
+             :agr {:number :sing
+                   :gender :fem}}}

    "usare"  {:synsem {:cat :verb
                       :sem {:pred :usare}}}


Cleanup logging

Cleanup logging

--- src/zaffre/animation/wrapper.cljc
+++ src/zaffre/animation/wrapper.cljc
@@ -34,7 +34,6 @@
 ;; util/helper fns
 (defn nil-grid [terminal]
   (let [[vw vh] (size terminal)]
-    (println "vw vh" vw vh)
     (repeat vh (vec (repeat vw nil)))))

 (defn lantern-flicker [opts x y fg]
@@ -189,8 +188,8 @@
   AMask
   (swap-mask! [this f]
     (swap! mask f)
-    (log/info "=====================")
-    (doseq [line @mask]
+    #_(log/info "=====================")
+    #_(doseq [line @mask]
       (log/info (mapv (fn [v] (if v 1 0)) line)))
     this)
   (reset-mask! [this new-mask]
@@ -222,10 +221,10 @@
     (let [path (zutil/line-segment-fast-without-endpoints (get transform :from-xy) (get transform :to-xy))
           n    (int (/ @frame-count 1))]
       (when (< n (count path))
-        (println "n" n "count path" (count path))
+        #_(log/info "n" n "count path" (count path))
         (let [[vx vy] path #_(rv/world-xy->screen-xy state (nth path n))]
           (when (or true (get-in mask [vy vx]))
-            (println "drawing * @ " vx vy)
+            #_(println "drawing * @ " vx vy)
             (zat/set-fx-char! terminal :fx vx vy \*)
             (zat/set-fx-fg! terminal :fx vx vy (zcolor/color->rgb :white))
             (zat/set-fx-bg! terminal :fx vx vy (zcolor/color->rgb :black))))))))
@@ -267,10 +266,10 @@
 (defn blink [terminal state blinks]
   ;(prinln (format "drawing %d blinks" (count blinks)))
   (doseq [blink blinks]
-    (println @frame-count (mod @frame-count 15))
+    #_(println @frame-count (mod @frame-count 15))
     (when (< (mod @frame-count 15) 7)
       (let [[vx vy] (get blink :xy)]
-          (println "drawing * @ " vx vy)
+          #_(println "drawing * @ " vx vy)
           (zat/set-fx-char! terminal :fx vx vy \space)))))

 (defrecord BlinkEffect
@@ -399,7 +398,7 @@
   (alter-group-pos! [_ group-id pos-fn] (zat/alter-group-pos! terminal group-id pos-fn))
   (alter-group-font! [_ group-id font-fn] (zat/alter-group-font! terminal group-id font-fn))
   (put-chars! [this layer-id characters]
-    (println "put-chars!" layer-id characters)
+    #_(log/debug "put-chars!" layer-id characters)
     (swap! opts
            (fn [opts]
              (reduce (fn [opts [y y-characters]]
@@ -419,7 +418,7 @@
     (zat/clear-fx! terminal)
     (doseq [effect @effects]
       (zaat/apply-effect! effect terminal))
-    (log/info "done applying effects")
+    #_(log/info "done applying effects")
     (zat/refresh! terminal))
   (clear! [this]
     (reset! opts (nil-grid terminal))
@@ -470,7 +469,7 @@

 (defn create-animated-terminal
   [terminal-fn group-map opts f]
-  (println "create-animated-terminal")
+  #_(log/debug "create-animated-terminal")
   (terminal-fn
     group-map
     opts
@@ -482,10 +481,10 @@
             opts            (atom (nil-grid terminal))
             effects         (atom (mapv (fn [effect-gen-fn] (effect-gen-fn terminal opts)) effects-gen-fns))
             filters         (atom filters)
-            _ (println "making atat pool")
+            #_#__ (println "making atat pool")
             schedule-pool   (atat/mk-pool)]
-        (log/info "overriding terminal")
-        (log/info "effects" @effects "filters" @filters)
+        #_(log/info "overriding terminal")
+        #_(log/info "effects" @effects "filters" @filters)
         (let [animated-terminal (->WrappedAnimatedTerminal terminal
                                                            started
                                                            opts


db/docids.clj: added functions to assign & save docids

--- src/org/altlaw/db/docids.clj
+++ src/org/altlaw/db/docids.clj
@@ -10,9 +10,6 @@
 (defn get-docids [collection]
   (data/get-data (str "docids/" collection)))

-(defn save-docids [collection]
-  (data/save-data (str "docids/" collection)))
-
 (defn get-docid [collection key]
   (get @(get-docids collection) key))

@@ -20,11 +17,27 @@
   (assert (coll? keys))
   (assert (every? string? keys))
   (assert (integer? docid))
-  (dosync (apply alter (get-docids collection)
-                 assoc (mapcat list keys (repeat docid)))))
+  (apply alter (get-docids collection)
+         assoc (mapcat list keys (repeat docid))))

-(defn get-next-docid []
-  (Integer/parseInt (props/get-property "next_docid")))
+(def get-next-docid
+     (memoize
+      (fn []
+        (ref (Integer/parseInt (props/get-property "next_docid"))))))

 (defn set-next-docid [docid]
-  (props/set-property "next_docid" docid))
+  (dosync (ref-set (get-next-docid) docid)))
+
+(defn- increment-next-docid []
+  (alter (get-next-docid) inc))
+
+(defn assign-next-docid [collection keys]
+  (dosync (set-docid collection keys @(get-next-docid))
+          (increment-next-docid)))
+
+(defn save-next-docid []
+  (props/set-property "next_docid" @(get-next-docid)))
+
+(defn save-docids [collection]
+  (data/save-data (str "docids/" collection)))
+


run compile/release/check sequentially when called from the CLI

for some reason I can't explain release builds fail intermittently
when running in parallel due to par-timeouts. util I find an
explanation for that its safer to run sequentially.

--- src/main/shadow/cljs/devtools/cli.clj
+++ src/main/shadow/cljs/devtools/cli.clj
@@ -24,50 +24,31 @@
     (apply var args)))

 (defn do-build-command [{:keys [action options] :as opts} build-config]
-  (try
-    (case action
-      :release
-      (api/release* build-config options)
-
-      :check
-      (api/check* build-config options)
-
-      :compile
-      (api/compile* build-config options))
-
-    :success
-    (catch Exception e
-      e)))
-
-(defn maybe-rethrow-exceptions [ex]
-  (case (count ex)
-    0 :success
-    1 (throw (first ex))
-    (throw (ex-info "multiple builds failed" {:exceptions ex}))
-    ))
+  (case action
+    :release
+    (api/release* build-config options)
+
+    :check
+    (api/check* build-config options)
+
+    :compile
+    (api/compile* build-config options)
+
+
+    (throw (ex-info "invalid action" {:opts opts :build-config  build-config}))))

 (defn do-build-commands
   [{:keys [builds] :as config} {:keys [action options] :as opts} build-ids]
-  ;; FIXME: this should start classpath/npm services so builds can use it
-  ;; if this is not a server instance
-
-  (->> build-ids
-       (map (fn [build-id]
-              (or (get builds build-id)
-                  (do (println (str "No config for build \"" (name build-id) "\" found."))
-                      ;; FIXME: don't repeat this
-                      (println (str "Available builds are: " (->> builds
-                                                                  (keys)
-                                                                  (map name)
-                                                                  (str/join ", "))))))))
-       (remove nil?)
-       (map #(future (do-build-command opts %)))
-       (into []) ;; force lazy seq
-       (map deref)
-       (remove #{:success})
-       (into []) ;; force again
-       ;; need to throw exceptions to ensure that cli commands can exit with proper exit codes
-       (maybe-rethrow-exceptions)))
+
+  ;; sequentially run the commands
+  (doseq [build-id build-ids]
+    (let [build-config (get builds build-id)]
+      (when-not build-config
+        (throw (ex-info (str "no build with id: " build-id)
+                 {:build-id build-id
+                  :known-builds (-> builds (keys) (set))})))
+
+      (do-build-command opts build-config))))

 (defn do-clj-eval [config {:keys [arguments options] :as opts}]
   (let [in


teach fs to take multiple txt strings (which will subsequently be separated with a space)

--- src/overtone/helpers/doc.clj
+++ src/overtone/helpers/doc.clj
@@ -72,8 +72,11 @@
        (indented-str-block* "" split-text 0 max-len wrap-indent))))

 (defn fs
-  "Format string. Synonym for indented-str-block but with a default
+  "Format string(s). Synonym for indented-str-block but with a default
    initial and wrap indentation of two characters. Also ensures that
    there is whitespace above and below the text."
-  [txt]
-  (indented-str-block (str "\n\n" txt "\n\n") 70 7 2))
+  [txt & rest]
+  (let [txt-list (apply list txt rest)
+        txt-list (interpose " " txt-list)
+        txt      (apply str txt-list)]
+    (indented-str-block (str "\n\n" txt "\n\n") 70 7 2)))