prevent Turntable use on a News Team or delayed usage

--- src/clj/game/cards-hardware.clj
+++ src/clj/game/cards-hardware.clj
@@ -510,42 +510,43 @@
    "Turntable"
    {:effect (effect (gain :memory 1))
     :leave-play (effect (lose :memory 1))
-    :events {:agenda-stolen {:effect (req (toast state :runner "Click Turntable to swap for a scored Corp agenda." "info")
-                                          (update! state side (assoc card :swap true)))}}
-    :abilities [{:optional
-                  {:req (req (:swap card))
-                   :prompt "Swap for a scored Corp agenda?"
-                   :yes-ability
-                   {:effect (req (let [agendas (get-in corp [:scored])]
-                                   (resolve-ability
-                                     state side
-                                     {:prompt "Choose a scored Corp agenda"
-                                      :choices {:req #(some (fn [c] (= (:cid %) (:cid c))) agendas)}
-                                      :effect (req (let [st (last (get-in runner [:scored]))
-                                                         sw target
-                                                         stpts-corp (get-agenda-points state :corp st)
-                                                         swpts-corp (get-agenda-points state :corp sw)
-                                                         stpts-runner (get-agenda-points state :runner st)
-                                                         swpts-runner (get-agenda-points state :runner sw)]
-                                                     (swap! state update-in [:corp :scored]
-                                                       (fn [coll] (conj (remove-once #(not= (:cid %) (:cid sw)) coll) st)))
-                                                     (swap! state update-in [:runner :scored]
-                                                       (fn [coll] (conj (remove-once #(not= (:cid %) (:cid st)) coll)
-                                                                        (dissoc sw :abilities :events))))
-                                                     (gain-agenda-point state :runner (- swpts-runner stpts-runner))
-                                                     (gain-agenda-point state :corp (- stpts-corp swpts-corp))
-                                                     (doseq [c (get-in @state [:corp :scored])]
-                                                       (let [abilities (:abilities (card-def c))
-                                                             c (merge c {:abilities abilities})]
-                                                         (update! state :corp c)
-                                                         (when-let [events (:events (card-def c))]
-                                                           (register-events state side events c))))
-                                                     (doseq [r (get-in @state [:runner :scored])]
-                                                       (deactivate state :corp r))
-                                                     (system-msg state side
-                                                       (str "uses Turntable to swap " (:title st) " for " (:title sw)))
-                                                     (update! state side (dissoc (get-card state card) :swap))))}
-                                    card nil)))}}}]}
+    :events {:agenda-stolen {:req (req (not (empty? (:scored corp))))
+                             :effect (req (toast state :runner "Click Turntable to swap for a scored Corp agenda." "info")
+                                          (update! state side (assoc card :swap true)))}
+             :runner-spent-click {:req (req (:swap card))
+                                  :effect (effect (update! (dissoc card :swap)))}}
+    :abilities [{:req (req (:swap card))
+                 :effect (req (let [agendas (get-in corp [:scored])
+                                    st (last (get-in runner [:scored]))]
+                                (resolve-ability
+                                  state side
+                                  {:req (req (is-type? st "Agenda"))
+                                   :prompt (msg "Choose a scored Corp agenda to swap for " (:title st))
+                                   :choices {:req #(some (fn [c] (= (:cid %) (:cid c))) agendas)}
+                                   :effect (req (let [sw target
+                                                      stpts-corp (get-agenda-points state :corp st)
+                                                      swpts-corp (get-agenda-points state :corp sw)
+                                                      stpts-runner (get-agenda-points state :runner st)
+                                                      swpts-runner (get-agenda-points state :runner sw)]
+                                                  (swap! state update-in [:corp :scored]
+                                                    (fn [coll] (conj (remove-once #(not= (:cid %) (:cid sw)) coll) st)))
+                                                  (swap! state update-in [:runner :scored]
+                                                    (fn [coll] (conj (remove-once #(not= (:cid %) (:cid st)) coll)
+                                                                     (dissoc sw :abilities :events))))
+                                                  (gain-agenda-point state :runner (- swpts-runner stpts-runner))
+                                                  (gain-agenda-point state :corp (- stpts-corp swpts-corp))
+                                                  (doseq [c (get-in @state [:corp :scored])]
+                                                    (let [abilities (:abilities (card-def c))
+                                                          c (merge c {:abilities abilities})]
+                                                      (update! state :corp c)
+                                                      (when-let [events (:events (card-def c))]
+                                                        (register-events state side events c))))
+                                                  (doseq [r (get-in @state [:runner :scored])]
+                                                    (deactivate state :corp r))
+                                                  (system-msg state side (str "uses Turntable to swap "
+                                                                              (:title st) " for " (:title sw)))
+                                                  (update! state side (dissoc (get-card state card) :swap))))}
+                                 card nil)))}]}

    "Unregistered S&W 35"
    {:abilities


Initialize Select2 outside of `initialize-exhibit3`

Because we are going to generalize the code we have for adding an exact
same input box on the Timetable Builder page.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/main.cljs
+++ src/cljs/cljs_nusmods/main.cljs
@@ -289,8 +289,6 @@
                                "moduleType" (js-obj "valueType" "item"))
                 "items"      itemsArray))
       (.configureFromDOM myExhibit)
-      (init-select2-element :#search-modules)
-      (init-dom-clear-modules)
       (aset js/window "Exhibit3_Initialized" true))))

 (defn- build-lessons-map-from-module-timetable
@@ -390,6 +388,10 @@
     (aset js/window "ActiveTab" TIMETABLE-TAB-INDEX)
     (aset js/window "ModulesMap" (build-timetable-module-map MODULES))

+    ; Iniialize Select2
+    (init-select2-element :#search-modules)
+    (init-dom-clear-modules)
+
     ; Code for tabs
     (hide ($ :#module-finder))
     (.click ($ :#module-finder-tab-link)


Use flash-get instead of sessions and dbs for saying "thanks".

I noticed in the DB that there were a few emails recorded as "Email
address". That means that someone (actually 4 people) clicked "Get
notified" without actually entering an email address. Oh well, silly
mistake, let's try again. But they couldn't because we had set the
flag and so they didn't get the form anymore. They could reset their
cookies, but who's going to do that.

So disable this silliness. If they refresh the page they get the form again.

--- src/circle/web/views/index.clj
+++ src/circle/web/views/index.clj
@@ -8,20 +8,18 @@
   (:use [circle.db :only (with-conn)])
   (:use [ring.util.response :only (redirect)])
   (:require [circle.model.beta-notify :as beta])
-  (:require [noir.cookies :as cookies])
   (:require [noir.session :as session]))

 (defpage [:post "/"] {:as request}
   (with-conn
-    (let [session-key (cookies/get "ring-session")]
-      (beta/insert {:email (:email request)
-                   :contact (= "true" (:contact request))
-                   :environment ""
-                   :features ""
-                   :session_key session-key})
-      (session/put! :signed-up "1")
-      (redirect "/"))))
+    (beta/insert {:email (:email request)
+                  :contact (= "true" (:contact request))
+                  :environment ""
+                  :features ""
+                  :session_key nil})
+    (session/flash-put! true)
+    (redirect "/")))

 (declare signupform youre-done)
@@ -34,7 +32,7 @@
         (center-vertically
           [:div#left-panel [:h1#cititle "Continuous Integration" [:br] "made easy"]])
         (center-vertically
-          [:div#right-panel (if (session/get :signed-up) (youre-done) (signupform))])
+          [:div#right-panel (if (session/flash-get) (youre-done) (signupform))])
         [:div.clear]]]

     [:div#content_wrap
@@ -92,7 +90,6 @@

 (defpartial youre-done [& content]
   (do
-;    (session/remove! :signed-up) ; For debugging
     [:div.move-right
       [:h2.blue-box "Thanks!" [:br] "We'll be in touch soon!"]]))


One more pure component

One more pure component

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -94,15 +94,15 @@
   ])

 (defn render-add-task
-  "Render the text field allowing to add new tasks to a card"
-  [card-ref]
+  "[Pure] Render the text field to add new tasks to a card"
+  [on-add]
   [:input.checklist--add-task
    {:type "text"
     :placeholder "Type then hit Enter to add a task"
     :on-key-press
     (fn [e]
       (when (= "Enter" (.-key e))
-        (swap! card-ref api/add-task (.. e -target -value))
+        (on-add (.. e -target -value))
         (set! (.. e -target -value) "")
       ))
    }])
@@ -115,6 +115,7 @@
         details-style (when-not show-details {:style {:display "none"}})
         on-remove-task #(swap! card-ref api/remove-task-at %)
         on-check-task #(swap! card-ref update-in [:tasks % :done] not)
+        on-add-task #(swap! card-ref api/add-task %)
         ]
     [:div.card
      [:div {:style (card-side-color @card-ref)}]
@@ -122,7 +123,7 @@
      [:div.card__details details-style
       (:description @card-ref)
       [render-tasks (:tasks @card-ref) on-remove-task on-check-task]
-      [render-add-task card-ref]
+      [render-add-task on-add-task]
     ]]
   ))


Change reader component a bit

Change reader component a bit

Now it displays the header even without any images

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -80,14 +80,15 @@
             comic-imgs @comic-imgs]
         (when (and site
                    location
-                   url-list
-                   comic-imgs)
-          [:div (str "Display chapter " (:chapter location)
+                   url-list)
+          [:div
+           [:h2 (str "Display chapter " (:chapter location)
                      " page " (:page location)
                      " of comic " (:comic location)
-                     " on site " site)
+                     " from site " site)]
            [:br]
-           comic-imgs])))))
+           (when comic-imgs
+             comic-imgs)])))))

 (defn comic-reader []
   (let [page (rf/subscribe [:page])]


Prevent games from loading files from outside their own directory

--- src/clojure/nightmod/public.clj
+++ src/clojure/nightmod/public.clj
@@ -13,7 +13,7 @@

 (defmacro load-game-file
   [n]
-  (some->> (io/file @u/project-dir n)
+  (some->> (io/file @u/project-dir (.getName (io/file n)))
            slurp
            (format "(do %s\n)")
            jail/safe-read))


Add printing to SiteScraper component start

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -293,7 +293,9 @@
   component/Lifecycle

   (start [component]
+    (println "Loading site definitions...")
     (let [sites (dissoc (get-sites) "test-site")]
+      (println "Found sites: " (str/join ", " (keys sites)))
       (assoc component :sites sites)))

   (stop [component]))


Ensure the chapter list is clean

Ensure the chapter list is clean

Enforce sorting by chapter number, and remove chapters that aren't
regular numbers.

--- src/clj/comic_reader/sites.clj
+++ src/clj/comic_reader/sites.clj
@@ -170,9 +170,11 @@
       chapter-link-add-ch-num))

 (defn extract-chapters-list [html comic-url]
-  (scrape/extract-list html
-                       (chapter-list-selector)
-                       chapter-link-normalize))
+  (->> (scrape/extract-list html
+                            (chapter-list-selector)
+                            chapter-link-normalize)
+       (filter :ch-num)
+       (sort-by :ch-num)))

 (defn comic->url [comic-id]
   (format (comic->url-format) (manga-url) comic-id))


back to white

back to white

--- src/clj/just_married/pages.clj
+++ src/clj/just_married/pages.clj
@@ -122,7 +122,7 @@
      [:body
       [:div.initial__root
        [:div.monogram__container
-        [:img.monogram {:src "images/monogram_navy.png"
+        [:img.monogram {:src "images/monogram_white.png"
                         :alt "Andrea & Enrica"}]]

        [:div.date__container (language date)]


create Storage protocol

create Storage protocol

--- src/clj_money/models/users.clj
+++ src/clj_money/models/users.clj
@@ -10,11 +10,58 @@
             [schema.coerce :as coerce]
             [schema.utils :as sutils]))

+(defprotocol Storage
+  "Provides data storage services for the application"
+  (create-user
+    [this user]
+    "Creates a new user record")
+  (select-users
+    [this]
+    "Returns all of the users in the system matching the specified criteria")
+  (find-user-by-email
+    [this email]
+    "Returns the user having the specified email"))
+
+(deftype SqlStorage [db-spec]
+  Storage
+
+  (create-user
+    [_ user]
+    (try
+      (->> user
+           (jdbc/insert! db-spec :users)
+           first)
+      (catch java.sql.BatchUpdateException e
+        (log/error (format "Unable to insert user %s: %s"
+                        user
+                        (.getMessage (.getNextException e))))
+        (throw e))))
+
+  (select-users
+    [_]
+    (let [sql (sql/format (-> (h/select :first_name :last_name :email)
+                              (h/from :users)))]
+      (jdbc/query db-spec sql)))
+
+  (find-user-by-email
+    [this email]
+    (let [sql (sql/format (-> (h/select :id :first_name :last_name :email :password)
+                              (h/from :users)
+                              (h/where [:= :email email])))]
+      (->> sql
+           (jdbc/query db-spec)
+           first))))
+
 (defn prepare-user-for-insertion
   "Prepares a user record to be saved in the database"
   [user]
   (-> user
       (update-in [:password] hash-bcrypt)))
+
+(defn prepare-user-for-return
+  "Prepares a user record for return to the caller"
+  [user]
+  (dissoc user :password))

 (def EmailPattern #"\A[\w\.-_]+@[\w\.-_]+\.\w{2,4}\z")

@@ -50,35 +97,23 @@
 (defn create
   "Creates a new user record"
   [data-store user]
-  (let [user (validate-new-user user)]
-    (try
-      (dissoc (->> user
-                   prepare-user-for-insertion
-                   (jdbc/insert! data-store :users)
-                   first)
-              :password)
-      (catch java.sql.BatchUpdateException e
-        (log/error (str "Unable to insert user "
-                        user
-                        ": "
-                        (.getMessage (.getNextException e))))))))
+  (->> user
+       validate-new-user
+       prepare-user-for-insertion
+       (create-user (SqlStorage. data-store))
+       prepare-user-for-return))

 (defn select
   "Lists the users in the database"
   [data-store]
-  (let [sql (sql/format (-> (h/select :first_name :last_name :email)
-                            (h/from :users)))]
-    (jdbc/query data-store sql)))
+  (select-users (SqlStorage. data-store)))

 (defn authenticate
   "Returns the user with the specified username and password.
   The returned map contains the information cemerick friend
   needs to operate"
   [data-store {:keys [username password]}]
-  (let [sql (sql/format (-> (h/select :id :first_name :last_name :email :password)
-                            (h/from :users)
-                            (h/where [:= :email username])))
-        user (first (jdbc/query data-store sql))]
+  (let [user (find-user-by-email (SqlStorage. data-store) username)]
     (when (and user (bcrypt-verify password (:password user)))
       (-> user
           (dissoc :password)


start tools.reader version parser and repo checkout

--- src/cljs_api_gen/repo_cljs.clj
+++ src/cljs_api_gen/repo_cljs.clj
@@ -9,13 +9,16 @@
     [cljs-api-gen.config :refer [repos-dir]]
     ))

-(def ^:dynamic *cljs-version* "ClojureScript version string   (e.g. \"0.0-3211\")" nil)
-(def ^:dynamic *cljs-num*     "ClojureScript version number   (e.g. 3211)" nil)
-(def ^:dynamic *cljs-tag*     "ClojureScript version git tag  (e.g. \"r3211\")" nil)
-(def ^:dynamic *cljs-date*    "ClojureScript version date     (e.g. \"2015-03-09\")" nil)
-(def ^:dynamic *clj-version*  "Clojure version string         (e.g. \"1.7.0-beta1\")" nil)
-(def ^:dynamic *clj-tag*      "Clojure version git tag        (e.g. \"clojure-1.7.0-beta1\"" nil)
-(def ^:dynamic *gclosure-lib* "Google Closure release         (e.g. \"0.0-20150505-021ed5b3\"" nil)
+(def ^:dynamic *cljs-version*    "ClojureScript version string   (e.g. \"0.0-3211\")" nil)
+(def ^:dynamic *cljs-num*        "ClojureScript version number   (e.g. 3211)" nil)
+(def ^:dynamic *cljs-tag*        "ClojureScript version git tag  (e.g. \"r3211\")" nil)
+(def ^:dynamic *cljs-date*       "ClojureScript version date     (e.g. \"2015-03-09\")" nil)
+(def ^:dynamic *clj-version*     "Clojure version string         (e.g. \"1.7.0-beta1\")" nil)
+(def ^:dynamic *clj-tag*         "Clojure version git tag        (e.g. \"clojure-1.7.0-beta1\"" nil)
+(def ^:dynamic *gclosure-lib*    "Google Closure release         (e.g. \"0.0-20150505-021ed5b3\"" nil)
+
+(def ^:dynamic *treader-version* "tools.reader version string    (e.g. \"0.9.2\"" nil)
+(def ^:dynamic *treader-tag*     "tools.reader git tag           (e.g. \"tools.reader-0.9.2\"" nil)

 (defn clone-or-pull!
   [repo-url]
@@ -31,7 +34,8 @@
   (when-not (exists? repos-dir)
     (mkdir repos-dir))
   (clone-or-pull! "https://github.com/clojure/clojurescript")
-  (clone-or-pull! "https://github.com/clojure/clojure"))
+  (clone-or-pull! "https://github.com/clojure/clojure")
+  (clone-or-pull! "https://github.com/clojure/tools.reader"))

 (defn get-current-repo-tag
   [repo]
@@ -60,6 +64,16 @@
   [version]
   (when-let [[_ n] (re-find #"\d\.\d-(.*)" version)]
     (str "r" n)))
+
+(defn treader-tag->version
+  [tag]
+  (when-let [[_ v] (re-find #"tools\.reader-(.*)")]
+    v))
+
+(defn treader-version->tag
+  [version]
+  (when version
+    (str "tools.reader-" version)))

 (defn ls-files
   [repo tag dir]
@@ -160,9 +174,18 @@
           (>= cljs-num 1847) (second (re-find #"(?m)^GCLOSURE_LIB_RELEASE=\"(.*)\"" bootstrap))
           (>= cljs-num 1798) (second (re-find #"google-closure-library-(.*)\.jar" bootstrap))
           (>= cljs-num 0)    (second (re-find #"closure-library-(.*)\.zip" bootstrap)))
+
+        treader
+        (cond
+          (>= cljs-num 1859) (second (re-find #"(?m)^TREADER_RELEASE=\"(.*)\"" bootstrap))
+          (>= cljs-num 1853) (second (re-find #"tools\.reader-(.*).jar" bootstrap))
+          (>= cljs-num 0)    nil ;; `clojure.lang/LispReader` used instead of tools.reader
+          )
         ]
     {:clj-version clojure
      :clj-tag (str "clojure-" clojure)
+     :treader-version treader
+     :treader-tag (treader-version->tag treader)
      :gclosure-lib gclosure-lib}))

 (defn checkout-repo!
@@ -171,11 +194,17 @@

 (defmacro with-checkout!
   [cljs-tag & body]
-  `(let [{clj-tag# :clj-tag
-          clj-version# :clj-version
-          gclosure-lib# :gclosure-lib} (cljs-tag->dep-releases ~cljs-tag)]
+  `(let [{clj-tag#          :clj-tag
+          clj-version#      :clj-version
+          treader-tag#      :treader-tag
+          treader-version#  :treader-version
+          gclosure-lib#     :gclosure-lib}    (cljs-tag->dep-releases ~cljs-tag)]
+
      (checkout-repo! "clojurescript" ~cljs-tag)
      (checkout-repo! "clojure" clj-tag#)
+     (when treader-tag#
+       (checkout-repo! "tools.reader" treader-tag#))
+
      (binding [*cljs-tag*     ~cljs-tag
                *cljs-date*    (repo-tag-date "clojurescript" ~cljs-tag)
                *cljs-version* (cljs-tag->version ~cljs-tag)
@@ -184,6 +213,9 @@
                *clj-tag*      clj-tag#
                *clj-version*  clj-version#

+               *treader-tag*     treader-tag#
+               *treader-version* treader-version#
+
                *gclosure-lib* gclosure-lib#]
        ~@body)))


Keep old function name for generate bytes on kdf ns for backward compatibility.

--- src/clojure/buddy/core/kdf.clj
+++ src/clojure/buddy/core/kdf.clj
@@ -22,6 +22,13 @@
   of kdf implemented in buddy."
   (generate-byte-array! [_ length] "Generate byte array of specified length.")
   (generate-byte-buffer! [_ length] "Generate byte buffer of specified length."))
+
+(defn generate-bytes!
+  "Generate a byte array of specified length.
+  WARNING: this method is deprecated but maintained
+  untile next version for backward compatibility."
+  [impl ^long length]
+  (generate-byte-array! impl length))

 (defn- generate-byte-array
   [impl length]


Add missing test for scale and translate matrix methods.


refer babel.engilsh/morph

refer babel.engilsh/morph

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -1,7 +1,7 @@
 (ns babel.test.en
   (:refer-clojure :exclude [get-in])
   (:require [babel.directory :refer [models]]
-            [babel.english :refer [analyze fo-ps generate medium parse sentences]]
+            [babel.english :refer [analyze fo-ps generate medium morph parse sentences]]
             [babel.english.grammar :as grammar]
             [babel.english.lexicon :refer [lexicon]]
             [babel.english.morphology :refer [fo get-string]]


create language models as promises

create language models as promises

--- test/babel/test/es.cljc
+++ test/babel/test/es.cljc
@@ -13,7 +13,11 @@
             #?(:cljs [babel.logjs :as log])
             [dag_unify.core :refer [get-in]]))

-(defn small [] (-> ((-> models :es)) deref))
+(def small-model (promise))
+(defn small [] (if (realized? small-model)
+                 @small-model
+                 @(deliver small-model (grammar/small))))
+
 (def medium-model (promise))
 (defn medium [] (if (realized? medium-model)
                   @medium-model
@@ -24,7 +28,7 @@
                                    :sem {:pred :sleep
                                          :subj {:pred :I}
                                          :tense :conditional}}}
-                         (grammar/small)
+                         (small)
                          {:truncate-children false})]
     (is (= :1st (get-in result [:comp :synsem :agr :person])))
     (is (= :sing (get-in result [:comp :synsem :agr :number])))
@@ -36,17 +40,17 @@
                 {:root {:espanol {:espanol "abrazar"}}
                  :synsem {:sem {:subj {:pred :I}}
                           :infl :preterito}}
-                (grammar/small)
+                (small)
                 {:truncate-children false})]
     (is (or (= "yo abracé" (fo result))
             (= "abracé" (fo result))))))

 (deftest llamarse
-  (let [result (engine/expression (grammar/small) {:synsem {:sem {:pred :be-called}}})]
+  (let [result (engine/expression (small) {:synsem {:sem {:pred :be-called}}})]
     (is (not (empty? (fo result))))))

 (deftest llamo
-  (let [result (fo (engine/expression (grammar/small)
+  (let [result (fo (engine/expression (small)
                                       {:synsem {:sem {:tense :present
                                                       :aspect :progressive
                                                       :subj {:pred :I}


cleanup

cleanup

--- test/babel/test/fr.cljc
+++ test/babel/test/fr.cljc
@@ -2,7 +2,7 @@
     babel.test.fr
   (:refer-clojure :exclude [get-in])
   (:require [babel.directory :refer [models]]
-            [babel.francais :as fr :refer [generate medium morph parse]]
+            [babel.francais :as fr :refer [generate morph parse]]
             [babel.francais.grammar :as grammar :refer [fo-ps]]
             [babel.francais.morphology :refer [analyze conjugate fo get-string]]
             [babel.generate :as generate]


rewrite roundtrip-present

rewrite roundtrip-present

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -96,6 +96,24 @@
                         expressions))))))

 (deftest roundtrip-present
+  (let [do-this-many 200
+        expressions (take do-this-many
+                          (repeatedly
+                           #(generate {:synsem {:cat :verb
+                                                :sem {:tense :present}
+                                                :subcat '()}}
+                                      small)))]
+    (is (= 200
+           (count (pmap (fn [expr]
+                          (let [fo (fo expr)
+                                parsed (parse fo)]
+                            (if (not (empty? parsed))
+                              (log/info (str "parse OK:" fo))
+                              (log/error (str "parse failed: " fo)))
+                            (is (not (empty? parsed)))))
+                        expressions))))))
+
+(deftest roundtrip-imperfect
   (let [do-this-many 200]
     (is (empty?
          (filter #(not (nil? %))
@@ -103,7 +121,9 @@
                        (take do-this-many
                              (repeatedly
                               #(generate {:synsem {:cat :verb
-                                                   :sem {:tense :present}
+                                                   :infl :imperfect
+                                                   :sem {:tense :past
+                                                         :aspec :progressive}
                                                    :subcat '()}}
                                          small)))]
                    (pmap (fn [expr]


Add executable macro

Add executable macro

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- src/emulator_chip8/opcode.cljc
+++ src/emulator_chip8/opcode.cljc
@@ -1,5 +1,5 @@
 (ns emulator-chip8.opcode
-  #?(:cljs (:require-macros [emulator-chip8.opcode :refer [defop]])))
+  #?(:cljs (:require-macros [emulator-chip8.opcode :refer [defop to-opcode-func]])))

 #?(:clj
    (defmacro defop
@@ -10,9 +10,14 @@
                  ['n 'n-addr]]]
        `(defn ~name ~args ~@body))))

+#?(:clj
+   (defmacro to-opcode-func [name]
+     (let [n  (symbol (str name))]
+       `(~n)
+       )))
+
 ;; 0NNN
 (defop 0NNN
-
   )

 ;; 00E0


Fix code formatting

Fix code formatting

Automatically fixed by cljfmt.


Multivar.

Multivar.


Moved helper function make-odd to new filters.util namespace.

--- src/funimage/filters/gabor.clj
+++ src/funimage/filters/gabor.clj
@@ -1,11 +1,9 @@
 (ns funimage.filters.gabor
   (:use [funimage imp project utils]
         [funimage.imp calculator roi]
-        [funimage.segmentation utils]))
+        [funimage.segmentation utils]
+        [funimage.filters utils]))

-(defn make-odd [n] (if (not (odd? n))
-                     (+ n 1)
-                     n))
 (defn gauss-0
   [x y sigma]
   (java.lang.Math/exp (/ (- 0 (+ (* x x) (* y y))) (* 2 sigma sigma))))


Missed a debug println

Missed a debug println

--- src/hphelper/scengen/print.clj
+++ src/hphelper/scengen/print.clj
@@ -50,7 +50,6 @@
   "Prints all the directives for the GM to view"
   [scenRec]
   (assert (scenRec :directives) "Directives do not exist?!")
-  (println "Directives: " (scenRec :directives))
   (html [:div
          [:b "Printing Directives:"]
          (interpose " -- "


Update process_lisp.clj

Update process_lisp.clj

--- src/iyye/bios/process_lisp.clj
+++ src/iyye/bios/process_lisp.clj
@@ -23,7 +23,7 @@

 (defn process-control [tree input IO]
   (let [cmd (first tree)
-        params (for [cur (rest tree)] (if (seq? cur) (process-control cur "substr" IO) cur))]
+        params (for [cur (rest tree)] (if (seq? cur) (process-control cur (str cur) IO) cur))]
     ;    (println "processing" cmd)
     (if cmd
       (dorun (words/action cmd params IO))
@@ -31,13 +31,11 @@

 (defn process-lispy-control [tree input IO]
   (let [cmd (first tree)
-        params (for [cur (rest tree)] (if (seq? cur) (process-lispy-control cur "substr" IO) cur))]
+        params (for [cur (rest tree)] (if (seq? cur) (process-lispy-control cur (str cur) IO) cur))]
     ;    (println "processing" cmd)
     (if cmd
       (dorun (scwords/action cmd params IO))
-      (future (Thread/sleep 500) (ioframes/process-output IO (str "failed to parse: " input)))
-      ))
-  )
+      (future (Thread/sleep 500) (ioframes/process-output IO (str "failed to parse: " input))))))

 (defn process-lispy-ctrl-input [IO input]
   (let [tree (parse/get-syntax-tree input)]


remove dbg pprint

remove dbg pprint

--- src/main/shadow/cljs/build.clj
+++ src/main/shadow/cljs/build.clj
@@ -15,7 +15,7 @@
             [cognitect.transit :as transit]
             [shadow.cljs.util :as util]
             [shadow.cljs.log :as log]
-            [clojure.pprint :refer (pprint)]
+    ;; [clojure.pprint :refer (pprint)]
             )
   (:import [java.io File StringWriter FileOutputStream FileInputStream StringReader PushbackReader ByteArrayOutputStream BufferedReader ByteArrayInputStream]
            [java.net URL]


Add follow-up-list and follow-up resources to handle creation and mark complete follow-ups.

--- src/oc/storage/api/entries.clj
+++ src/oc/storage/api/entries.clj
@@ -6,6 +6,7 @@
             [taoensso.timbre :as timbre]
             [compojure.core :as compojure :refer (ANY OPTIONS DELETE)]
             [liberator.core :refer (defresource by-method)]
+            [clojure.walk :refer (keywordize-keys)]
             [schema.core :as schema]
             [oc.lib.schema :as lib-schema]
             [oc.lib.db.pool :as pool]
@@ -114,6 +115,28 @@

     true)) ; no existing entry, so this will fail existence check later

+(defn- valid-follow-up-request? [conn entry-uuid follow-up-map user]
+  (let [existing-entry (entry-res/get-entry conn entry-uuid)
+        ts (db-common/current-timestamp)
+        with-keys (keywordize-keys follow-up-map)
+        self? (:self with-keys)
+        assignees (if self?
+                    [(lib-schema/author-for-user user)]
+                    (:assignees with-keys))
+        follow-ups (map #(hash-map :assignee %
+                                  :uuid (db-common/unique-id)
+                                  :created-at ts
+                                  :author (lib-schema/author-for-user user)
+                                  :completed? false)
+                         assignees)]
+    (if existing-entry
+      (if (every? #(lib-schema/valid? common-res/FollowUp %) follow-ups)
+        {:existing-entry (api-common/rep existing-entry)
+         :self? self?
+         :follow-ups (api-common/rep follow-ups)}
+        [false, {:follow-ups (api-common/rep follow-ups)}]) ; invalid share request
+      true))) ;; wil fail existence later
+
 (defn- entry-list-for-board
   "Retrieve an entry list for the board, or false if the org or board doesn't exist."
   [conn org-slug board-slug-or-uuid ctx]
@@ -149,6 +172,39 @@
       {:updated-entry (api-common/rep update-result)})
     (do
       (timbre/error "Failed sharing entry:" entry-for) false)))
+
+(defn- create-follow-ups [conn ctx entry-for]
+  (timbre/info "Creating " (count (:follow-ups ctx)) " follow-ups for entry:" entry-for)
+  (if-let* [org (:existing-org ctx)
+            board (:existing-board ctx)
+            entry (:existing-entry ctx)
+            user (:user ctx)
+            follow-ups (:follow-ups ctx)
+            updated-entry (entry-res/add-follow-ups! conn entry follow-ups user)
+            entry-with-comments (assoc entry :existing-comments (entry-res/list-comments-for-entry conn (:uuid entry)))]
+    (do
+      ;; TODO: Trigger notifications for created follow-ups
+      ;; (when (and (seq? follow-ups) (any? follow-ups)))
+      (timbre/info "Follow-ups created for entry:" entry-for)
+      {:updated-entry (api-common/rep updated-entry)})
+    (do
+      (timbre/error "Failed creating follow-ups for entry:" entry-for) false)))
+
+(defn- mark-complete-follow-up [conn ctx entry-for]
+  (timbre/info "Marking complete follow-up " (:uuid (:existing-follow-up ctx)) " for entry:" entry-for)
+  (if-let* [org (:existing-org ctx)
+            board (:existing-board ctx)
+            entry (:existing-entry ctx)
+            follow-up (:existing-follow-up ctx)
+            user (:user ctx)
+            updated-entry (entry-res/complete-follow-up! conn entry follow-up user)
+            entry-with-comments (assoc entry :existing-comments (entry-res/list-comments-for-entry conn (:uuid entry)))]
+    (do
+      ;; TODO: Trigger notifications for completed follow-up
+      (timbre/info "Follow-up marked complete for entry:" entry-for)
+      {:updated-entry (api-common/rep updated-entry)})
+    (do
+      (timbre/error "Failed marking complete follow-up for entry:" entry-for) false)))

 (defn auto-share-on-publish
   [conn ctx entry-result]
@@ -379,7 +435,7 @@
                           :get true
                           :post (fn [ctx] (api-common/known-content-type? ctx mt/entry-media-type))
                           :delete true})
-
+
   ;; Authorization
   :allowed? (by-method {
     :options true
@@ -522,7 +578,7 @@
     :post (fn [ctx] (let [entry-props (:data ctx)]
                       (or (nil? entry-props) ; no updates during publish is fine
                           (valid-entry-update? conn entry-uuid entry-props))))})
-  :new? false
+  :new? false
   :respond-with-entity? true

   ;; Existentialism
@@ -565,7 +621,7 @@
   :allowed? (by-method {
     :options true
     :post (fn [ctx] (access/allow-authors conn org-slug board-slug (:user ctx)))})
-
+
   ;; Media type client accepts
   :available-media-types (by-method {
                             :post [mt/entry-media-type]})
@@ -578,7 +634,7 @@
                           :post (fn [ctx] (api-common/known-content-type? ctx mt/share-request-media-type))})

   ;; Data handling
-  :new? false
+  :new? false
   :respond-with-entity? true

   ;; Validations
@@ -682,6 +738,132 @@
                                                   (-> ctx :user :user-id)
                                                   :secure))))

+(defresource follow-up-list [conn org-slug board-slug entry-uuid]
+  (api-common/open-company-authenticated-resource config/passphrase) ; verify validity and presence of required JWToken
+  :allowed-methods [:options :post]
+
+  ;; Authorization
+  :allowed? (by-method {
+    :options true
+    :post (fn [ctx] (access/allow-authors conn org-slug board-slug (:user ctx)))})
+
+  ;; Media type client accepts
+  :available-media-types (by-method {
+                            :post [mt/entry-media-type]})
+  :handle-not-acceptable (by-method {
+                            :post (api-common/only-accept 406 mt/entry-media-type)})
+
+  ;; Media type client sends
+  :known-content-type? (by-method {
+                          :options true
+                          :post (fn [ctx] (api-common/known-content-type? ctx mt/follow-up-media-type))})
+
+  ;; Data handling
+  :new? false
+  :respond-with-entity? true
+
+  ;; Validations
+  :processable? (by-method {
+    :options true
+    :post (fn [ctx] (valid-follow-up-request? conn entry-uuid (:data ctx) (:user ctx)))})
+
+  ;; Existentialism
+  :can-post-to-missing? false
+  :exists? (fn [ctx] (if-let* [_slugs? (and (slugify/valid-slug? org-slug)
+                                            (slugify/valid-slug? board-slug))
+                               org (or (:existing-org ctx)
+                                       (org-res/get-org conn org-slug))
+                               org-uuid (:uuid org)
+                               entry (or (:existing-entry ctx)
+                                         (entry-res/get-entry conn entry-uuid))
+                               board (board-res/get-board conn (:board-uuid entry))
+                               _matches? (and (= org-uuid (:org-uuid entry))
+                                              (= org-uuid (:org-uuid board))
+                                              (= :published (keyword (:status entry)))) ; sanity check
+                               comments (or (:existing-comments ctx)
+                                            (entry-res/list-comments-for-entry conn (:uuid entry)))
+                               reactions (or (:existing-reactions ctx)
+                                             (entry-res/list-reactions-for-entry conn (:uuid entry)))]
+                        {:existing-org (api-common/rep org) :existing-board (api-common/rep board)
+                         :existing-entry (api-common/rep entry) :existing-comments (api-common/rep comments)
+                         :existing-reactions (api-common/rep reactions)}
+                        false))
+
+  ;; Actions
+  :post! (fn [ctx] (create-follow-ups conn ctx (s/join " " [org-slug board-slug entry-uuid])))
+
+  ;; Responses
+  :handle-ok (fn [ctx] (entry-rep/render-entry (:existing-org ctx)
+                                               (:existing-board ctx)
+                                               (:updated-entry ctx)
+                                               (:existing-comments ctx)
+                                               (reaction-res/aggregate-reactions (:existing-reactions ctx))
+                                               (:access-level ctx)
+                                               (-> ctx :user :user-id)))
+  :handle-unprocessable-entity (fn [ctx]
+    (api-common/unprocessable-entity-response (map #(schema/check common-res/FollowUp %) (:follow-ups ctx)))))
+
+(defresource follow-up [conn org-slug board-slug entry-uuid follow-up-uuid]
+  (api-common/open-company-authenticated-resource config/passphrase) ; verify validity and presence of required JWToken
+  :allowed-methods [:options :post]
+
+  ;; Authorization
+  :allowed? (by-method {
+    :options true
+    :post (fn [ctx] (access/allow-authors conn org-slug board-slug (:user ctx)))})
+
+  ;; Media type client accepts
+  :available-media-types (by-method {
+                            :post [mt/entry-media-type]})
+  :handle-not-acceptable (by-method {
+                            :post (api-common/only-accept 406 mt/entry-media-type)})
+
+  ;; Data handling
+  :new? false
+  :respond-with-entity? true
+
+  ;; Validations
+  :processable? true
+
+  ;; Existentialism
+  :can-post-to-missing? false
+  :exists? (fn [ctx] (if-let* [_slugs? (and (slugify/valid-slug? org-slug)
+                                            (slugify/valid-slug? board-slug))
+                               org (or (:existing-org ctx)
+                                       (org-res/get-org conn org-slug))
+                               org-uuid (:uuid org)
+                               entry (or (:existing-entry ctx)
+                                         (entry-res/get-entry conn entry-uuid))
+                               board (board-res/get-board conn (:board-uuid entry))
+                               follow-up (first (filter #(= (:uuid %) follow-up-uuid) (:follow-ups entry)))
+                               _matches? (and (= org-uuid (:org-uuid entry))
+                                              (= org-uuid (:org-uuid board))
+                                              (= :published (keyword (:status entry)))) ; sanity check
+                               comments (or (:existing-comments ctx)
+                                            (entry-res/list-comments-for-entry conn (:uuid entry)))
+                               reactions (or (:existing-reactions ctx)
+                                             (entry-res/list-reactions-for-entry conn (:uuid entry)))]
+                        {:existing-org (api-common/rep org) :existing-board (api-common/rep board)
+                         :existing-entry (api-common/rep entry)
+                         :existing-follow-up (api-common/rep follow-up)
+                         :existing-comments (api-common/rep comments)
+                         :existing-reactions (api-common/rep reactions)}
+                        false))
+
+  ;; Actions
+  :post! (fn [ctx] (mark-complete-follow-up conn ctx (s/join " " [org-slug board-slug entry-uuid])))
+
+  ;; Responses
+  :handle-ok (fn [ctx] (entry-rep/render-entry (:existing-org ctx)
+                                               (:existing-board ctx)
+                                               (:updated-entry ctx)
+                                               (:existing-comments ctx)
+                                               (reaction-res/aggregate-reactions (:existing-reactions ctx))
+                                               (:access-level ctx)
+                                               (-> ctx :user :user-id)))
+  :handle-unprocessable-entity (fn [ctx]
+    (api-common/unprocessable-entity-response (map #(schema/check common-res/FollowUp %) (:follow-ups ctx)))))
+
 ;; ----- Routes -----

 (defn routes [sys]
@@ -754,4 +936,12 @@
       (ANY "/orgs/:org-slug/boards/:board-slug/entries/:entry-uuid/share/"
         [org-slug board-slug entry-uuid]
         (pool/with-pool [conn db-pool]
-          (share conn org-slug board-slug entry-uuid))))))+          (share conn org-slug board-slug entry-uuid)))
+      (ANY "/orgs/:org-slug/boards/:board-slug/entries/:entry-uuid/follow-up"
+        [org-slug board-slug entry-uuid]
+        (pool/with-pool [conn db-pool]
+          (follow-up-list conn org-slug board-slug entry-uuid)))
+      (ANY "/orgs/:org-slug/boards/:board-slug/entries/:entry-uuid/follow-up/:follow-up-uuid/complete"
+        [org-slug board-slug entry-uuid follow-up-uuid]
+        (pool/with-pool [conn db-pool]
+          (follow-up conn org-slug board-slug entry-uuid follow-up-uuid))))))


Use new prepare-batch interface.

Use new prepare-batch interface.

--- src/onyx/plugin/bookkeeper.clj
+++ src/onyx/plugin/bookkeeper.clj
@@ -301,7 +301,7 @@
     (zero? @in-flight-writes)
     true)

-  (prepare-batch [this event replica]
+  (prepare-batch [this event _ _]
     true)

   (checkpointed! [this epoch])


Improve usability of core.async plugin.

Improve usability of core.async plugin.

--- src/onyx/plugin/core_async.clj
+++ src/onyx/plugin/core_async.clj
@@ -20,6 +20,8 @@
     [@replica-version @epoch])

   (recover! [this replica-version* checkpoint]
+    (when-not (map? @(:core.async/buffer event))
+      (throw (Exception. "A buffer atom must now be supplied to the core.async plugin under :core.async/buffer. This atom must contain a map.")))
     ;; resume logic is somewhat broken
     (let [buf @(:core.async/buffer event)
           resume-to (or checkpoint (first (sort (keys buf))))


Fix broken BookKeeper test

Fix broken BookKeeper test

--- src/onyx_jepsen/bookkeeper.clj
+++ src/onyx_jepsen/bookkeeper.clj
@@ -59,7 +59,7 @@
 (def || (c/lit "||"))

 (def env-config
-  (-> "onyx-peers/resources/prod-env-config.edn" slurp read-string))
+  (-> "resources/prod-env-config.edn" slurp read-string))

 (defn bk-cfg-servers
   [test]
@@ -158,7 +158,7 @@
                         (loop [results []
                                entries (.readEntries ledger-handle 0 last-confirmed)
                                element ^LedgerEntry (.nextElement entries)]
-                          (let [new-results (conj results (nippy/decompress (.getEntry element)))]
+                          (let [new-results (conj results (nippy/window-log-decompress (.getEntry element)))]
                             (if (.hasMoreElements entries)
                               (recur new-results entries (.nextElement entries))
                               new-results)))
@@ -196,7 +196,7 @@
                     (try
                       (do
                         (info "Adding entry" (:value op))
-                        (.addEntry ledger-handle (nippy/compress (:value op)))
+                        (.addEntry ledger-handle (nippy/window-log-compress (:value op)))
                         (info "Done adding entry" (:value op))
                         (assoc op :type :ok :ledger-id (.getId ledger-handle)))
                       (catch Throwable t


add tracking code for mixpanel

add tracking code for mixpanel

--- frontend/components/errors.cljs
+++ frontend/components/errors.cljs
@@ -26,7 +26,11 @@
           [:div.container
            (condp = status
              401 [:p
-                  [:b [:a {:href (gh-utils/auth-url)}
+                  [:b [:a {:href (gh-utils/auth-url)
+             :on-click #(put! controls-ch [:track-external-link-clicked {:event "Auth GitHub"
+                                                                         :properties {:source "401"
+                                                                                :url js/window.location.pathname}
+                                                                         :path (gh-utils/auth-url)}])}
                        "Login here"]]
                   " to view this page"]
              404 (if (and (not logged-in?) (or dashboard-page? build-page?))


extend slider to allow settings for size

--- src/sierpinski_sieve/core.cljs
+++ src/sierpinski_sieve/core.cljs
@@ -42,12 +42,13 @@
         (doseq [[y row] (map-indexed vector sieve)]
           (paint-row ctx y row size))))))

-(defn slider [name key value]
+(defn slider [name key value settings]
   [:div
    [:label name
-    [:input {:type "range" :min 2 :max 32 :step 1 :value value
-             :on-change
-             (fn [e] (swap! app-state assoc key (int (.-target.value e))))}]
+    [:input (merge {:value value
+                    :on-change
+                    (fn [e] (swap! app-state assoc key (int (.-target.value e))))}
+                   settings)]
     value]])

 (defn render-canvas []
@@ -55,14 +56,8 @@
     [:center
      [:h1 "Sierpinski Triangle"]
      [:canvas {:width size :height size :id "canvas"}]
-     [:div
-      [:label "Size"
-       [:input {:type "range" :min 100 :max 1200 :step 100 :value size
-                :on-change (fn [e]
-                             (let [value (int (.-target.value e))]
-                               (swap! app-state assoc :size value)))}]
-       size]]
-     (slider "Modulus" :modulus modulus)
+     (slider "Size" :size size {:type "range" :min 100 :max 1200 :step 100})
+     (slider "Modulus" :modulus modulus {:type "range" :min 2 :max 32 :step 1})
      [:p
       "© 2017 Charles L.G. Comstock "
       [:a {:href "https://github.com/dgtized/sierpinski-sieve"} "(github)"]]]))


Link to org settings in the project settings page.

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -130,29 +130,31 @@
           [:a.aside-item {:href "/invite-teammates"} "Invite a Teammate"]
           [:a.aside-item {:href "/logout"} "Logout"]]]))))

-(def project-settings-nav-items
-  [{:type :heading :title "Project Settings"}
-   {:type :subpage :href "edit" :title "Overview" :subpage :overview}
-   {:type :heading :title "Tweaks"}
-   {:type :subpage :href "#parallel-builds" :title "Adjust Parallelism" :subpage :parallel-builds}
-   {:type :subpage :href "#env-vars" :title "Environment variables" :subpage :env-vars}
-   {:type :subpage :href "#experimental" :title "Experimental Settings" :subpage :experimental}
-   {:type :heading :title "Test Commands"}
-   {:type :subpage :href "#setup" :title "Dependency Commands" :subpage :setup}
-   {:type :subpage :href "#tests" :title "Test Commands" :subpage :tests}
-   {:type :heading :title "Notifications"}
-   {:type :subpage :href "#hooks" :title "Chat Notifications" :subpage :hooks}
-   {:type :subpage :href "#webhooks" :title "Webhook Notifications" :subpage :webhooks}
-   {:type :subpage :href "#badges" :title "Status Badges" :subpage :badges}
-   {:type :heading :title "Permissions"}
-   {:type :subpage :href "#checkout" :title "Checkout SSH keys" :subpage :checkout}
-   {:type :subpage :href "#ssh" :title "SSH Permissions" :subpage :ssh}
-   {:type :subpage :href "#api" :title "API Permissions" :subpage :api}
-   {:type :subpage :href "#aws" :title "AWS Permissions" :subpage :aws}
-   {:type :heading :title "Continuous Deployment"}
-   {:type :subpage :href "#heroku" :title "Heroku Deployment" :subpage :heroku}
-   {:type :subpage :href "#aws-codedeploy" :title "AWS CodeDeploy" :subpage :aws-codedeploy}
-   {:type :subpage :href "#deployment" :title "Other Deployments" :subpage :deployment}])
+(defn project-settings-nav-items [data owner]
+  (let [navigation-data (:navigation-data data)]
+    [{:type :heading :title "Project Settings"}
+     {:type :subpage :href (routes/v1-org-settings navigation-data) :title "Org Settings"}
+     {:type :subpage :href "edit" :title "Overview" :subpage :overview}
+     {:type :heading :title "Tweaks"}
+     {:type :subpage :href "#parallel-builds" :title "Adjust Parallelism" :subpage :parallel-builds}
+     {:type :subpage :href "#env-vars" :title "Environment variables" :subpage :env-vars}
+     {:type :subpage :href "#experimental" :title "Experimental Settings" :subpage :experimental}
+     {:type :heading :title "Test Commands"}
+     {:type :subpage :href "#setup" :title "Dependency Commands" :subpage :setup}
+     {:type :subpage :href "#tests" :title "Test Commands" :subpage :tests}
+     {:type :heading :title "Notifications"}
+     {:type :subpage :href "#hooks" :title "Chat Notifications" :subpage :hooks}
+     {:type :subpage :href "#webhooks" :title "Webhook Notifications" :subpage :webhooks}
+     {:type :subpage :href "#badges" :title "Status Badges" :subpage :badges}
+     {:type :heading :title "Permissions"}
+     {:type :subpage :href "#checkout" :title "Checkout SSH keys" :subpage :checkout}
+     {:type :subpage :href "#ssh" :title "SSH Permissions" :subpage :ssh}
+     {:type :subpage :href "#api" :title "API Permissions" :subpage :api}
+     {:type :subpage :href "#aws" :title "AWS Permissions" :subpage :aws}
+     {:type :heading :title "Continuous Deployment"}
+     {:type :subpage :href "#heroku" :title "Heroku Deployment" :subpage :heroku}
+     {:type :subpage :href "#aws-codedeploy" :title "AWS CodeDeploy" :subpage :aws-codedeploy}
+     {:type :subpage :href "#deployment" :title "Other Deployments" :subpage :deployment}]))

 (defn project-settings-menu [app owner]
   (reify
@@ -167,7 +169,7 @@
             [:a.close-menu {:href "./"} ; This may need to change if we drop hashtags from url structure
              (common/ico :fail-light)]]
            [:div.aside-user-options
-            (for [item project-settings-nav-items]
+            (for [item (project-settings-nav-items app owner)]
               (case (:type item)

                 :heading


Whitespace.

Whitespace.

--- src/task_tracker/app/core.cljs
+++ src/task_tracker/app/core.cljs
@@ -1,11 +1,11 @@
 (ns task-tracker.app.core
   (:require task-tracker.app.router
-            [task-tracker.app.history        :as history]
-            [task-tracker.app.state          :as app-state]
-            [task-tracker.app.models.session :as session]
+            [task-tracker.app.history           :as history]
+            [task-tracker.app.state             :as app-state]
+            [task-tracker.app.models.session    :as session]
             [task-tracker.app.components.navbar :as navbar]
-            [om.core                         :as om  :include-macros true]
-            [om.dom                          :as dom :include-macros true])
+            [om.core                            :as om  :include-macros true]
+            [om.dom                             :as dom :include-macros true])
   (:require-macros [om-utils.core :refer [defcomponent]]))

 (enable-console-print!)


fix typos

fix typos

--- src/babel/english/lexicon-verbcoach.clj
+++ src/babel/english/lexicon-verbcoach.clj
@@ -1,4 +1,4 @@
-(ns babel.english.lexicon
+(ns babel.english.lexicon-verbcoach
   (:refer-clojure :exclude [get-in])
   (:require
    [babel.encyclopedia :as encyc]
@@ -232,7 +232,7 @@
                                             :1plur "were able"
                                             :2plur "were able"
                                             :3plur "were able"}
-                                            :past-participle "been able"}}}]
+                                            :past-participle "been able"}}]
                [(unify common
                        {:modal-with :infinitive
                         :synsem {:cat :verb
@@ -242,7 +242,6 @@
                                  :sem {:pred :be-able-to}
                                  :subcat {:1 {:cat :top}
                                           :2 '()}}})])
-
    "be born" {:synsem {:cat :verb
                        :sem {:pred :be-born}
                        :subcat {:2 '()}}
@@ -446,12 +445,11 @@
                                       :pronoun true
                                       :reflexive true
                                       :sem subject-semantics}}}})])
-
    "come" {:synsem {:cat :verb
                     :sem {:pred :come}
                     :subcat {:2 '()}}
-           :english {:past "came"}
-         {:past-participle "come"}}
+           :english {:past "came"
+                     :past-participle "come"}}

    "comment" {:synsem {:cat :verb
                        :sem {:pred :comment}}}
@@ -906,7 +904,7 @@
            {:synsem {:cat :verb
             :english {:present {:3sing "has"}
                       :past "had"}
-            :modal-with :infinitive}]
+            :modal-with :infinitive}}]

    ;; TODO: move all "have X"s to "have" with a subcat argument, a la phrasal verbs e.g. "putting on"
    "have dinner" {:synsem {:cat :verb
@@ -2284,7 +2282,7 @@
                       :subcat {:1 {:cat :noun}
                                :2 {:cat :comp
                                    :comp-type :if
-
+                                   :subcat '()}}}}
    "work" [{:synsem {:cat :verb
                      :sem {:pred :work-human}}
             :english {:note "human"}}
@@ -2378,46 +2376,45 @@
              :sem {:human true
                    :reflexive false
                    :pred :voi}
-             :subcat '()}}
-
-             {:english {:note "v ♂"}
-               :synsem {:cat :noun
-                        :pronoun true
-                        :reflexive false
-                        :case :top ;; see comment in "it" about :case.
-                        :agr {:person :2nd
-                              :gender :masc
-                              :number :plur}
-                        :sem {:human true
-                              :reflexive false
-                              :pred :voi}
-                        :subcat '()}}
-
-              {:english {:note "v ♀"}
-                :synsem {:cat :noun
-                          :pronoun true
-                          :reflexive false
-                          :case :top ;; see comment in "it" about :case.
-                          :agr {:person :2nd
-                                :gender :fem
-                                :number :plur}
-                          :sem {:human true
-                                :reflexive false
-                                :pred :voi}
-                          :subcat '()}}
-
-              {:english {:note "u"}
-               :synsem {:cat :noun
-                       :pronoun true
-                       :reflexive false
-                       :case :top ;; see comment in "it" about :case.
-                       :agr {:person :2nd
-                             :number :plur}
-                       :sem {:human true
-                             :reflexive false
-                             :pred :voi}
-                       :subcat '()}}]
-
+              :subcat '()}}
+
+    {:english {:note "v ♂"}
+     :synsem {:cat :noun
+              :pronoun true
+              :reflexive false
+              :case :top ;; see comment in "it" about :case.
+              :agr {:person :2nd
+                    :gender :masc
+                    :number :plur}
+              :sem {:human true
+                    :reflexive false
+                    :pred :voi}
+              :subcat '()}}
+
+    {:english {:note "v ♀"}
+     :synsem {:cat :noun
+              :pronoun true
+              :reflexive false
+              :case :top ;; see comment in "it" about :case.
+              :agr {:person :2nd
+                    :gender :fem
+                    :number :plur}
+              :sem {:human true
+                    :reflexive false
+                    :pred :voi}
+              :subcat '()}}
+
+    {:english {:note "u"}
+     :synsem {:cat :noun
+              :pronoun true
+              :reflexive false
+              :case :top ;; see comment in "it" about :case.
+              :agr {:person :2nd
+                    :number :plur}
+              :sem {:human true
+                    :reflexive false
+                    :pred :voi}
+              :subcat '()}}]
    "your"
    (map #(unify %
                 {:synsem {:cat :det
@@ -2471,12 +2468,8 @@
               :sem {:human true
                     :pred :voi}
               :subcat '()}}]
-   })
-
-
-(declare lexicon)
-
-;; TODO: allow a filter of lexemes
+  })
+
 (defn- deliver-lexicon []
   (-> (compile-lex lexicon-source
                    morph/exception-generator
@@ -2744,7 +2737,6 @@
                    :sem {:obj obj-sem}}}))

       ;; </prep default rules>
-
 ))

 (def lexicon-promise (promise))


Update project.clj

Update project.clj

--- src/jarkeeper/views/project.clj
+++ src/jarkeeper/views/project.clj
@@ -4,7 +4,6 @@
             [hiccup.core :refer [html]]
             [hiccup.page :refer [html5 include-css include-js]]
             [hiccup.util :refer [escape-html]]))
-

 (defn- render-deps [deps]
   (for [dep deps]


sensors - 1st cut of rejig to new code style.

--- src/kixi/hecuba/api/sensors.clj
+++ src/kixi/hecuba/api/sensors.clj
@@ -10,32 +10,45 @@
    [liberator.core :refer (defresource)]
    [liberator.representation :refer (ring-response)]))

+(defn- entity-id-from [ctx]
+  (get-in ctx [:request :route-params :entity-id]))
+
+(defn- device-id-from [ctx]
+  (get-in ctx [:request :route-params :device-id]))
+
+(defn metadata-exists? [querier ctx]
+  (when-let [items (hecuba/items querier :sensor-metadata {:device-id (device-id-from ctx)})]
+    {::items items}))
+
+(defn metadata-handle-ok []
+    {::items items}
+         ;downcast-to-json
+         ;camelify
+         ;encode
+         )
+
+(defn index-by-property-handle-ok [querier ctx]
+  (let [devices (hecuba/items querier
+                              :device
+                              {:entity-id (entity-id-from ctx)})
+        sensors (mapcat (fn [{:keys [id location]}]
+                          (map #(assoc % :location (json/decode location))
+                               (hecuba/items querier
+                                             :sensor {:device-id id})))
+                        devices)]
+    (util/render-items request sensors)))
+
 (defresource metadata [{:keys [commander querier]} handlers]
   :allowed-methods #{:get}
   :available-media-types #{"text/html" "application/json"}
   :known-content-type? #{"application/json"}
   :authorized? (authorized? querier :device)
-
-  :exists? (fn [{{{:keys [entity-id device-id]} :route-params} :request}]
-             (when-let [items (hecuba/items querier :sensor-metadata {:device-id device-id})]
-               {::items items}))
-
-  :handle-ok
-  (fn [{items ::items {mime :media-type} :representation {routes :modular.bidi/routes route-params :route-params} :request :as request}]
-    items
-         ;downcast-to-json
-         ;camelify
-         ;encode
-         ))
+  :exists? (partial metadata-exists? querier)
+  :handle-ok (partial metadata-handle-ok))

 (defresource index-by-property [{:keys [commander querier]} handlers]
   :allowed-methods #{:get}
   :available-media-types #{"application/json"}
   :known-content-type? #{"application/json"}
   :authorized? (authorized? querier :measurement)
-  :handle-ok (fn [{{{:keys [entity-id]} :route-params} :request
-                  {mime :media-type} :representation :as req}]
-               (let [devices (hecuba/items querier :device {:entity-id entity-id})
-                     sensors (mapcat (fn [{:keys [id location]}]
-                                       (map #(assoc % :location (json/decode location)) (hecuba/items querier :sensor {:device-id id}))) devices)]
-                 (util/render-items req sensors))))
+  :handle-ok (index-by-property-handle-ok ))


Handle features in cqp expression

Handle features in cqp expression

--- src/cljs/cglossa/search_inputs/cwb.cljs
+++ src/cljs/cglossa/search_inputs/cwb.cljs
@@ -221,7 +221,9 @@
                                               (re-find #"^\.\+" val) (assoc :end? true))

                                       "pos"
-                                      (assoc m :pos val))))
+                                      (assoc m :pos val)
+
+                                      (update-in m [:features] assoc name val))))
                                 {}
                                 attrs))
       quoted-or-empty-term (.log js/console "quoted-or-empty")


Hide remove button on first query row

Hide remove button on first query row

--- src/cljs/cglossa/search_inputs/cwb.cljs
+++ src/cljs/cglossa/search_inputs/cwb.cljs
@@ -62,18 +62,21 @@
    (for [language languages]
      [:option {:key (:value language) :value (:value language)} (:text language)])])

-(defn- simple [query-cursor]
+(defn- simple [query-cursor show-remove-btn?]
   (let [query           (:query @query-cursor)
         displayed-query (str/replace query #"\[\(?\w+=\"(.+?)\"(?:\s+%c)?\)?\]" "$1")
         phonetic?       (not= -1 (.indexOf query "phon="))]
     [:form {:style {:display "table" :margin-left -30 :margin-bottom 20}}
      [:div {:style {:display "table-row" :margin-bottom 10}}
-      [:button.btn.btn-default.btn-xs {:style {:display "table-cell"
-                                               :margin-right 5
-                                               :margin-top -25}}
-       [:span.glyphicon.glyphicon-remove]]
+      [:div {:style {:display "table-cell"}}
+       [:button.btn.btn-default.btn-xs {:style {:margin-right 5
+                                                :margin-top   -25
+                                                :visibility   (if show-remove-btn?
+                                                                "visible"
+                                                                "hidden")}}
+        [:span.glyphicon.glyphicon-remove]]]
       [:div.form-group {:style {:display "table-cell"}}
-       [:input.form-control.col-md-12 {:style {:width 500}
+       [:input.form-control.col-md-12 {:style       {:width 500}
                                        :type        "text"
                                        :value       displayed-query
                                        :on-change   #(on-text-changed % query-cursor phonetic?)
@@ -121,7 +124,8 @@
      ; because ratoms cannot be derefed inside lazy seqs.
      (doall (for [index (range (count @search-queries))]
               (let [query-cursor      (reagent/cursor search-queries [index])
+                    show-remove-btn?  (pos? index)
                     selected-language (-> @query-cursor :query :lang)]
                 (when multilingual? [language-select languages selected-language])
-                ^{:key index} [view query-cursor])))
+                ^{:key index} [view query-cursor show-remove-btn?])))
      (when-not multilingual? [add-phrase-button])]))


fix missing key warnings

fix missing key warnings

--- src/cljs/daveconservatoire/site/ui.cljs
+++ src/cljs/daveconservatoire/site/ui.cljs
@@ -310,7 +310,7 @@

 (om/defui ^:once LessonCell
   static om/IQuery
-  (query [_] [:lesson/title :youtube/id :lesson/type :url/slug])
+  (query [_] [:db/id :lesson/title :youtube/id :lesson/type :url/slug])

   static om/Ident
   (ident [_ props] (u/model-ident props))
@@ -323,7 +323,7 @@
               (dom/img #js {:src (u/lesson-thumbnail-url lesson) :key "img"})
               (dom/p #js {:key "p"} title))))))

-(def lesson-cell (om/factory LessonCell))
+(def lesson-cell (om/factory LessonCell {:keyfn :db/id}))

 (om/defui ^:once TopicSideBarLink
   static om/IQuery
@@ -755,8 +755,9 @@
     (let [{:keys [topic/lessons]} (om/props this)
           lesson-groups (partition 6 6 nil lessons)]
       (dom/div #js {:className "thumbnails"}
-        (for [lessons lesson-groups]
-          (dom/div #js {:className "row" :style #js {:margin "0 0 20px 0"}}
+        (for [[i lessons] (map vector (range) lesson-groups)]
+          (dom/div #js {:className "row" :style #js {:margin "0 0 20px 0"}
+                        :key i}
             (map lesson-cell lessons)))))))

 (def home-course-topic-open (om/factory HomeCourseTopicOpen {:keyfn :db/id}))


wip user view

wip user view

--- src/cljs/dokkaa_builder/views/user.cljs
+++ src/cljs/dokkaa_builder/views/user.cljs
@@ -20,4 +20,12 @@
     (render-state [this state]
       (html [:div {:id "app-view"}
              [:ul (map (fn [t] [:li t])
-                       (:api-tokens app))]]))))
+                       (:api-tokens app))]
+             [:div
+              [:button {:class "pure-button pure-button-primary"
+                        :on-click
+                        (fn [e]
+                          (go
+                            (let [{body :body} (<! (api/add-access-token "dokkaa.io:8080"))]
+                             (om/transact! app :api-tokens #(conj % body)))))}
+               "New Token"]]]))))


handle ratpack Promise as response

handle ratpack Promise as response

--- src/clojure/catacumba/impl/handlers.clj
+++ src/clojure/catacumba/impl/handlers.clj
@@ -119,7 +119,11 @@
                       (-> data
                           (p/then callback)
                           (p/catch callback))))
-        (hp/then #(-handle-response % context)))))
+        (hp/then #(-handle-response % context))))
+
+  ratpack.exec.Promise
+  (-handle-response [data ^DefaultContext context]
+    (hp/then data #(-handle-response % context))))

 (extend-protocol ISend
   (Class/forName "[B")


fix interrupt clearing when switching interrupt mode in session

--- src/clojure/zensols/cisql/db_access.clj
+++ src/clojure/zensols/cisql/db_access.clj
@@ -325,14 +325,13 @@
    (execute-query query display-result-set))
   ([query query-handler-fn]
    (assert-connection)
+   (reset! interrupt-execute-query nil)
    (if (not (conf/config :sigintercept))
      (execute-query-nowait query query-handler-fn)
-     (do
-       (reset! interrupt-execute-query nil)
-       (let [query-fut (future (execute-query-nowait query query-handler-fn))
-             wait-fut (poll-for-quit interrupt-execute-query query-fut 1000)]
-         (deref wait-fut)
-         (log/debugf "execute wait on feature complete"))))))
+     (let [query-fut (future (execute-query-nowait query query-handler-fn))
+           wait-fut (poll-for-quit interrupt-execute-query query-fut 1000)]
+       (deref wait-fut)
+       (log/debugf "execute wait on feature complete")))))

 (defn show-table-metadata
   "Display the meta data of **table**, which includes column names and metadata."


[l.d.compile] Make user-defined build-config options override default ones

--- src/leiningen/droid/compile.clj
+++ src/leiningen/droid/compile.clj
@@ -64,8 +64,9 @@
         package-path       (apply io/file gen-path (st/split package-name #"\."))
         version-name       (-> project :version)
         application-id     (or (-> project :android :rename-manifest-package) package-name)
-        template-constants (map-constants (merge build-config {"VERSION_NAME"   version-name
-                                                               "APPLICATION_ID" application-id}))]
+        template-constants (map-constants (merge {"VERSION_NAME"   version-name
+                                                  "APPLICATION_ID" application-id}
+                                                 build-config))]
     (ensure-paths package-path)
     (->> {:debug        (dev-build? project)
           :package-name package-name


mark protocols with @interface

mark protocols with @interface

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -1866,7 +1866,10 @@
                                        (throw
                                          (missing-protocol
                                            ~(core/str psym "." fname) ~(first sig))))))))))
-             psym   (vary-meta psym assoc-in [:protocol-info :methods]
+             psym (-> psym
+                    (vary-meta update-in [:jsdoc] conj
+                      "@interface")
+                    (vary-meta assoc-in [:protocol-info :methods]
                       (into {}
                         (map
                           (core/fn [[fname & sigs]]
@@ -1875,7 +1878,7 @@
                                        sigs (take-while vector? sigs)]
                               [(vary-meta fname assoc :doc doc)
                                (vec sigs)]))
-                          methods)))
+                          methods))))
              method (core/fn [[fname & sigs]]
                       (core/let [doc (core/as-> (last sigs) doc
                                        (core/when (core/string? doc) doc))


Do not create `record-meta` when in CLJS.

--- src/active/clojure/record.cljc
+++ src/active/clojure/record.cljc
@@ -1,5 +1,13 @@
 (ns active.clojure.record
-  (:require [active.clojure.lens :as lens]))
+  #?@
+  (:clj
+   [(:require
+     [active.clojure.lens :as lens]
+     [active.clojure.macro :refer [if-cljs]])]
+   :cljs
+   [(:require
+     [active.clojure.lens :as lens]
+    (:require-macros [active.clojure.macro :refer [if-cljs]])]))

 ;; Only needed in ClojureScript, does nothing in Clojure
 (defn check-type
@@ -13,8 +21,31 @@
 (defrecord RecordMeta
     ;; unresolved store for record related symbols. May not leak outside this
     ;; namespace. Contains ns to allow post-macro qualification; see `record-meta` function.
-    [predicate constructor ordered-accessors ns])
+    [predicate constructor ordered-accessors])

+(defmacro resolve*
+  [& args]
+  `(if-cljs nil (resolve ~@args)))
+
+(defmacro intern*
+  [& args]
+  `(if-cljs nil (intern ~@args)))
+
+(defmacro make-record-meta
+  [?predicate ?constructor ?constructor-args ?field-triples]
+  #?(:cljs nil) ;; we don't return meta in cljs
+  #?(:clj
+  (do
+    ;; we need to internalize symbols to ns resolve them
+    (intern* *ns* ?predicate)
+    (intern* *ns* ?constructor)
+    (->RecordMeta
+     (resolve* ?predicate) (resolve* ?constructor)
+     (mapv (fn [constr]
+             (let [accessor (second (first (filter #(= (first %) constr) ?field-triples)))]
+               (intern* *ns* accessor)
+               (resolve* accessor)))
+           ?constructor-args)))))

 #?(:clj
 (defmacro define-record-type
@@ -84,18 +115,7 @@
                     (str "[[" (ns-name *ns*) "/" name "]]"))
         ?docref (str "See " (reference ?constructor) ".")

-        ;; we need to internalize symbols to ns resolve them
-        _ (intern *ns* ?predicate)
-        _ (intern *ns* ?constructor)
-
-        record-meta (->RecordMeta
-                     (resolve ?predicate) (resolve ?constructor)
-                     (mapv (fn [constr]
-                             (let [accessor (second (first (filter #(= (first %) constr) ?field-triples)))]
-                               (intern *ns* accessor)
-                               (resolve accessor)))
-                           ?constructor-args)
-                     *ns*)]
+        record-meta `(make-record-meta ~?predicate ~?constructor ~?constructor-args ~?field-triples)]

     (let [?field-names-set (set ?field-names)]
       (doseq [?constructor-arg ?constructor-args]


"be (be-called)" constrains gender and number via agreement between subject and object

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -131,10 +131,15 @@

            ;; be + propernoun, e.g. "My name is John"
-           (let [subj-agr (atom {:person :3rd})
+           (let [gender (atom :top)
+                 number (atom :top)
+                 subj-agr (atom {:person :3rd
+                                 :gender gender
+                                 :number number})
                  infl (atom :top)
                  the-real-subj (atom :top)
-                 the-obj (atom :top)]
+                 the-obj (atom {:number number
+                                :gender gender})] ;; prevents e.g. "Her name is John"
              (unify common
                     subject-verb-agreement
                     {:intransitivize false
@@ -796,7 +801,9 @@
                    :obj {:human true}}}}
    "her"
    [{:synsem {:cat :det
-              :sem {:pred :lei}
+              :sem {:pred :lei
+                    :gender :fem
+                    :number :sing}
               :def :possessive}}

     {:synsem {:cat :noun
@@ -844,7 +851,7 @@
    "his" {:synsem {:cat :det
                    :sem {:pred :lui
                          :gender :masc
-                         :person :sing}
+                         :number :sing}
                    :def :possessive}}

    "hit" {:english {:past "hit"}
@@ -1186,7 +1193,8 @@
    "my"
    (map #(unify %
                 {:synsem {:cat :det
-                          :sem {:pred :I}
+                          :sem {:pred :I
+                                :number :sing}
                           :def :possessive}})
         [{:synsem {:agr {:number :sing}}}
          {:synsem {:agr {:number :plur}}}])
@@ -1236,7 +1244,8 @@
    (map #(unify %
                 {:synsem {:cat :det
                           :agr {:gender :masc}
-                          :sem {:pred :noi}
+                          :sem {:pred :noi
+                                :number :plur}
                           :def :possessive}})
         [{:synsem {:agr {:number :sing}}}
          {:synsem {:agr {:number :plur}}}])
@@ -1557,7 +1566,8 @@
    "their"
    (map #(unify %
                 {:synsem {:cat :det
-                          :sem {:pred :loro}
+                          :sem {:pred :loro
+                                :number :plur}
                           :def :possessive}})
         [{:synsem {:agr {:number :sing}}}
          {:synsem {:agr {:number :plur}}}])


add more phrasal verbs for "turn"

add more phrasal verbs for "turn"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2237,7 +2237,12 @@
               :sem {:pred :turn-down}
               :subcat {:2 {:cat :prep
                            :sem {:pred :down}}}}}
-    ;; TODO: add "turn down the radio"
+    ;; "turn down the radio"
+    {:phrasal-verb true
+     :synsem {:cat :verb
+              :sem {:pred :turn-down}
+              :subcat {:3 {:cat :prep
+                           :sem {:pred :down}}}}}

     ;; "turn the radio off"
     {:phrasal-verb true
@@ -2271,7 +2276,12 @@
               :sem {:pred :turn-up}
               :subcat {:2 {:cat :prep
                            :sem {:pred :up}}}}}
-    ;; TODO: add "turn up the radio"
+    ;; "turn up the radio"
+    {:phrasal-verb true
+     :synsem {:cat :verb
+              :sem {:pred :turn-up}
+              :subcat {:3 {:cat :prep
+                           :sem {:pred :up}}}}}
     ]

     "understand" (let [common {:english {:past "understood"}}]


fix call to parse/parse

fix call to parse/parse

--- src/babel/english/workbook.clj
+++ src/babel/english/workbook.clj
@@ -46,15 +46,9 @@

 (defn parse
   ([string]
-   (parse/parse string
-                (:lexicon small)
-                (:lookup small)
-                (:grammar small)))
+   (parse/parse string medium))
   ([string model]
-   (parse/parse string
-                (:lexicon model)
-                (:lookup model)
-                (:grammar model))))
+   (parse/parse string model)))

 (defn expr [id]
   (reader/id2expression (Integer. id)))


working on French reflexives

working on French reflexives

--- src/babel/francais/grammar.clj
+++ src/babel/francais/grammar.clj
@@ -382,11 +382,15 @@
                                      :infl :present
                                      :sem {:tense :present}
                                      :cat :verb}})
+
+                   ;; [s-present "je" [vp-pronoun "m'" "amuse"]]
                    (unifyc c21
-                           {:comp {:phrasal false
+                           root-is-head
+                           {:head {:phrasal false}
+                            :comp {:phrasal false
                                    :synsem {:cat :noun
                                             :pronoun true}}
-                            :rule "vp-pronoun"
+                            :rule "vp-pronoun-nonphrasal"
                             :synsem {:cat :verb
                                      :infl {:not :past}}})
                    (unifyc h10


Switch entries to map containing :queue and :predicate (for whether we can play from the queue)

--- test/onyx/log/generators.clj
+++ test/onyx/log/generators.clj
@@ -71,32 +71,34 @@
                                  (when (seq reactions)
                                    [peer-id reactions])))
                              peers)
-        side-effects (keep (partial generate-side-effects entry replica new-replica diff) peers)
-        new-entries (concat peer-reactions side-effects)
+        side-effects (keep (partial generate-side-effects entry replica new-replica diff)
+                           peers)
+        new (concat peer-reactions side-effects)
         ; it does not matter that multiple reactions are processed
         ; together because they may be processed interleaved depending on
         ; the choice of peer queue being popped
         unapplied (reduce (fn [new-entries [peer-id reactions]]
-                            (update-in new-entries
-                                       [peer-id]
-                                       (fn [entries] (-> entries
-                                                         vec
-                                                         (into reactions)
-                                                         (bump-forward-immediates (:peers replica) peer-id)))))
+                            (-> new-entries
+                                (update-in [peer-id :queue]
+                                           (fn [queue]
+                                             (-> queue
+                                                 vec
+                                                 (into reactions)
+                                                 (bump-forward-immediates (:peers replica) peer-id))))))
                           entries
-                          new-entries)]
+                          new)]
     (vector new-replica diff unapplied)))

 (defn apply-peer-queue-entry
   "Applies the next log message in the selected peer's queue.
   Effectively, the next peer that wrote its message to ZK"
   [{:keys [replica message-id entries peer-choices log]} next-peer]
-  (let [peer-queue (entries next-peer)
+  (let [peer-queue (:queue (entries next-peer))
         next-entry (first peer-queue)
         new-peer-queue (vec (rest peer-queue))
         new-entries (if (empty? new-peer-queue)
                       (dissoc entries next-peer)
-                      (assoc entries next-peer new-peer-queue))
+                      (assoc-in entries [next-peer :queue] new-peer-queue))
         message (assoc next-entry :message-id message-id)
         [new-replica diff updated-entries] (apply-entry replica new-entries message)]
     {:replica new-replica
@@ -104,15 +106,6 @@
      :entries updated-entries
      :log (conj log [message diff])
      :peer-choices (conj peer-choices next-peer)}))
-
-;; This should be a predicate that can be setup on the queue
-;; to decide when to allow the queue to progress - makes things easier
-;; so you can start backpressure events and have known results
-(defn allow-queue? [{:keys [peer-state] :as replica}
-                    [{:keys [args] :as entry} & es]]
-  (or (and (= :backpressure-on (:fn entry))
-           (= :active (get peer-state (:peer args))))
-      (= :backpressure-off (:fn entry))))

 (defn queue-select-gen
   "Generator to look into all of the peer's write queues
@@ -125,15 +118,18 @@
               ; because non-immediate reactions are buffered til join
               (let [replica (:replica state)
                     peerless-queues (->> (:entries state)
-                                         (filter (fn [[queue-id queue]]
+                                         (filter (fn [[queue-id {:keys [predicate queue]}]]
                                                    (or (peerless-entry? (first queue))
-                                                       (allow-queue? replica queue))))
+                                                       ((or predicate (constantly true))
+                                                        replica
+                                                        (first queue)))))
                                          (map key))
                     joined-peers (set (:peers replica))
                     selectable-peers (->> (:entries state)
-                                          (filter (fn [[peer [entry]]]
-                                                    (or (:immediate? entry)
-                                                        (contains? joined-peers peer))))
+                                          (filter (fn [[peer {:keys [queue]}]]
+                                                    (let [entry (first queue)]
+                                                      (or (:immediate? entry)
+                                                          (contains? joined-peers peer)))))
                                           (map key)
                                           set)
                     selectable-queues (into selectable-peers peerless-queues)]
@@ -176,8 +172,9 @@

 (defn generate-join-queues [peer-ids]
   (zipmap peer-ids
-          (map (comp vector build-join-entry)
-               peer-ids)))
+          (map (fn [peer]
+                 {:queue [(build-join-entry peer)]})
+               peer-ids)))

 (defn generate-peer-ids [n]
   (map #(keyword (str "p" %))


test fixes

test fixes

--- test/s7p/slave/core_test.clj
+++ test/s7p/slave/core_test.clj
@@ -15,38 +15,52 @@
           :winnotice "http://example.com/winnotice"})

 (deftest validate-test
-  (testing "`validate`"
-    (testing "204 no bid"
-      (let [ret (validate {:dsp dsp1 :status 204 :body ""})]
-       (is (= :no-bid (:status ret)))))
+  (let [req1 {:id "1" :floorPrice 3.0 :site "http://test.org/" :device "Ubuntu Touch" :user "user1" :test 0}
+        req2 {:id "1" :floorPrice nil :site "http://test.org/" :device "Ubuntu Touch" :user "user1" :test 0}]
+   (testing "`validate`"
+     (testing "204 no bid"
+       (let [ret (validate req1 {:dsp dsp1 :status 204 :body ""})]
+         (is (= :no-bid (:status ret)))))

-    (testing "invalid response status"
-      (let [ret (validate {:dsp dsp1 :status 201 :body ""})]
-       (is (= :invalid (:status ret)))))
+     (testing "invalid response status"
+       (let [ret (validate req1 {:dsp dsp1 :status 201 :body ""})]
+         (is (= :invalid (:status ret)))))

-    (testing "empty response"
-     (let [ret (validate {:dsp dsp1 :status 200 :body ""})]
-       (is (= :invalid (:status ret)))))
+     (testing "empty response"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body ""})]
+         (is (= :invalid (:status ret)))))

-    (testing "invalid json string"
-      (let [ret (validate {:dsp dsp1 :status 200 :body "{"})]
-       (is (= :invalid (:status ret)))))
+     (testing "invalid json string"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{"})]
+         (is (= :invalid (:status ret)))))

-    (testing "valid request"
-      (let [ret (validate {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"bidPrice\": 0.1, \"advertiserId\": \"1\"}"})]
-       (is (= :valid (:status ret)))))
+     (testing "valid response"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"bidPrice\": 4000.0, \"advertiserId\": \"1\"}"})]
+         (is (= :valid (:status ret)))))

-    (testing "no id"
-      (let [ret (validate {:dsp dsp1 :status 200 :body "{\"bidPrice\": 0.1, \"advertiserId\": \"1\"}"})]
-       (is (= :invalid (:status ret)))))
+     (testing "valid response2"
+       (let [ret (validate req2 {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"bidPrice\": 4000.0, \"advertiserId\": \"1\"}"})]
+         (is (= :valid (:status ret)))))

-    (testing "no bidPrice"
-     (let [ret (validate {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"advertiserId\": \"1\"}"})]
-       (is (= :invalid (:status ret)))))
+     (testing "no id"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{\"bidPrice\": 4000.0, \"advertiserId\": \"1\"}"})]
+         (is (= :invalid (:status ret)))))

-    (testing "no advertiserId"
-      (let [ret (validate {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"advertiserId\": \"1\"}"})]
-       (is (= :invalid (:status ret)))))))
+     (testing "under floor"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"bidPrice\": 1000.0, \"advertiserId\": \"1\"}"})]
+         (is (= :invalid (:status ret)))))
+
+     (testing "no bidPrice"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"advertiserId\": \"1\"}"})]
+         (is (= :invalid (:status ret)))))
+
+     (testing "no advertiserId"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{\"id\": \"1\", \"bidPrice\": 4000.0}"})]
+         (is (= :invalid (:status ret)))))
+
+     (testing "non maching id"
+       (let [ret (validate req1 {:dsp dsp1 :status 200 :body "{\"id\": \"2\", \"bidPrice\": 4000.0, \"advertiserId\": \"1\"}"})]
+         (is (= :invalid (:status ret))))))))

 (deftest auction-test
   (testing "`auction`"