fix typo from cut-and-paste from conditional to future

--- src/babel/francais/morphology/verbs.clj
+++ src/babel/francais/morphology/verbs.clj
@@ -102,8 +102,8 @@
         number (get-in word '(:agr :number))
         number-and-person (number-and-person number person)]
     (cond
-     (get-in word [:conditional number-and-person])
-     (get-in word [:conditional number-and-person])
+     (get-in word [:future number-and-person])
+     (get-in word [:future number-and-person])

      (and (= person :1st) (= number :sing) er-type)
      (str stem "erai")


reuse the taxo reader, link the reader and searchermanager together

--- src/bzzz/index_directory.clj
+++ src/bzzz/index_directory.clj
@@ -14,16 +14,17 @@
            (org.apache.lucene.facet.taxonomy.directory DirectoryTaxonomyWriter DirectoryTaxonomyReader)
            (org.apache.lucene.index IndexWriter IndexReader IndexWriterConfig DirectoryReader)
            (org.apache.lucene.search Query ScoreDoc SearcherManager IndexSearcher)
-           (org.apache.lucene.store NIOFSDirectory Directory)))
+           (org.apache.lucene.store NIOFSDirectory Directory NoSuchDirectoryException)))

 (declare use-searcher)
 (declare use-writer)
 (declare bootstrap-indexes)
-(declare get-search-manager)
+(declare get-smanager-taxo)
+(declare try-close-manager-taxo)

 (def root* (atom default-root))
 (def identifier* (atom default-identifier))
-(def name->smanager* (atom {}))
+(def name->smanager-taxo* (atom {}))

 (def acceptable-name-pattern (re-pattern "[^a-zA-Z_0-9-]"))
 (def shard-suffix "-shard-")
@@ -68,38 +69,40 @@
 (defn new-taxo-reader ^DirectoryTaxonomyReader [name]
   (DirectoryTaxonomyReader. (new-index-directory (taxo-dir-prefix name) "__taxo__")))

+(defn try-new-taxo-reader ^DirectoryTaxonomyReader [name]
+  (try
+    (new-taxo-reader name)
+    (catch Exception e
+      (if (instance? NoSuchDirectoryException e)
+        (do
+          (log/warn (ex-str e))
+          (let [writer ^DirectoryTaxonomyWriter (new-taxo-writer name)]
+            (.commit writer)
+            (.close writer))
+          (new-taxo-reader name))))))
+
 (defn new-index-reader ^IndexReader [name]
   (with-open [writer (new-index-writer name)]
     (DirectoryReader/open ^IndexWriter writer false)))

+(defn new-searcher-manager ^SearcherManager [name]
+  (SearcherManager. (new-index-directory (root-identifier-path) name) nil))
+
 (defn sharded [index x-shard]
   (let [shard (int-or-parse x-shard)]
     (str (as-str index) shard-suffix (str shard))))

 (defn reset-search-managers []
-  (doseq [[name ^SearcherManager manager] @name->smanager*]
+  (doseq [[name [manager taxo]] @name->smanager-taxo*]
     (log/info "\tclosing: " name " " manager)
-    (.close manager))
-  (reset! name->smanager* {}))
-
-(defn use-taxo-reader [index callback]
-  ;; FIXME: reuse
-  (let [reader (try
-                 (new-taxo-reader index)
-                 (catch Throwable e
-                   (do
-                     (log/warn (ex-str e))
-                     nil)))]
-    (try
-      (callback reader)
-      (finally (if reader
-                 (.close ^DirectoryTaxonomyReader reader))))))
+    (try-close-manager-taxo manager taxo))
+  (reset! name->smanager-taxo* {}))

 (defn use-searcher [index callback]
-  (let [manager (get-search-manager index)
+  (let [[^SearcherManager manager taxo] (get-smanager-taxo index)
         searcher ^IndexSearcher (.acquire manager)]
     (try
-      (use-taxo-reader index (fn [^DirectoryTaxonomyReader reader] (callback searcher reader)))
+      (callback searcher taxo)
       (finally (.release manager searcher)))))

 (defn log-close-err [^Directory dir ^Throwable e]
@@ -107,7 +110,8 @@
              (.toString dir)
              " Got exception while close()ing the writer,and directory is still locked."
              " Unlocking it. "
-             "[ should never happen, there is a race between this IndexWriter/unlock and other process/thread IndexWriter/open ]"
+             "[ should never happen, there is a race between this IndexWriter/unlock "
+             " and other process/thread IndexWriter/open ]"
              " Exception: " (ex-str e))))

 (defn safe-close-writer [^IndexWriter writer]
@@ -128,6 +132,18 @@
         (do
           (log-close-err (.getDirectory taxo) e)
           (DirectoryTaxonomyWriter/unlock (.getDirectory taxo)))))))
+
+(defn try-close-manager-taxo [^SearcherManager manager ^DirectoryTaxonomyReader taxo]
+  (try
+    (do
+      (try
+        (.close taxo)
+        (catch Exception e
+          (log/warn (as-str e))))
+      (.close manager))
+    (catch Exception e
+      (log/warn (as-str e)))))
+

 (defn use-writer [index callback]
   (let [writer (new-index-writer index)
@@ -161,43 +177,57 @@
   (try
     (doseq [dir (sub-directories)]
       (try
-        (get-search-manager (.getName dir))
+        (get-smanager-taxo (.getName ^File dir))
         (catch Exception e
           (log/warn (ex-str e)))))
     (catch Exception e
       (log/warn (ex-str e)))))

-(defn get-search-manager ^SearcherManager [index]
-  (locking name->smanager*
-    (when (nil? (@name->smanager* index))
-      (swap! name->smanager* assoc index (SearcherManager. (new-index-directory (root-identifier-path) index)
-                                                    nil)))
-    (@name->smanager* index)))
+(defn get-smanager-taxo [index]
+  (locking name->smanager-taxo*
+    (when (nil? (@name->smanager-taxo* index))
+      (swap! name->smanager-taxo* assoc index [(new-searcher-manager index)
+                                               (try-new-taxo-reader index)]))
+    (@name->smanager-taxo* index)))

 (defn refresh-search-managers []
   (bootstrap-indexes)
-  (locking name->smanager*
-    (doseq [[index ^SearcherManager manager] @name->smanager*]
+  (locking name->smanager-taxo*
+    (doseq [[index [^SearcherManager manager
+                    ^DirectoryTaxonomyReader taxo]] @name->smanager-taxo*]
       (log/debug "refreshing: " index " " manager)
-      ;; FIXME - reopen cached taxo readers
       (try
-        (.maybeRefresh manager)
+        (do
+          (.maybeRefresh manager)
+          (if-let [changed (DirectoryTaxonomyReader/openIfChanged taxo)]
+            (swap! name->smanager-taxo* assoc-in [index 1] changed)))
         (catch Throwable e
           (do
-            (log/info (str index " maybeRefresh exception, closing it. Exception: " (ex-str e)))
-            (.close manager)
-            (swap! name->smanager* dissoc index)))))))
+            (log/info (str index " refresh exception, closing it. Exception: " (ex-str e)))
+            (try-close-manager-taxo manager taxo)
+            (swap! name->smanager-taxo* dissoc index)))))))
+

 (defn shutdown []
-  (locking name->smanager*
-    (log/info "executing shutdown hook, current mapping: " @name->smanager*)
+  (locking name->smanager-taxo*
+    (log/info "executing shutdown hook, current mapping: " @name->smanager-taxo*)
     (reset-search-managers)
-    (log/info "mapping after cleanup: " @name->smanager*)))
+    (log/info "mapping after cleanup: " @name->smanager-taxo*)))

 (defn index-stat []
-  (into {} (for [[name searcher] @name->smanager*]
+  (into {} (for [[name [manager taxo]] @name->smanager-taxo*]
              [name (use-searcher name
                                  (fn [^IndexSearcher searcher ^DirectoryTaxonomyReader taxo-reader]
                                    (let [reader (.getIndexReader searcher)]
                                      {:docs (.numDocs reader)
-                                      :has-deletions (.hasDeletions reader)})))])))
+                                      :searcher {:to-string (.toString searcher)
+                                                 :sim (.toString (.getSimilarity searcher))}
+                                      :manager {:to-string (.toString manager)}
+                                      :reader {:to-string (.toString reader)
+                                               :leaves (count (.leaves reader))
+                                               :refcnt (.getRefCount reader)
+                                               :deleted-docs (.numDeletedDocs reader)
+                                               :has-deletions (.hasDeletions reader)}
+                                      :taxo {:size (.getSize taxo-reader)
+                                             :to-string (.toString taxo-reader)
+                                             :refcnt (.getRefCount taxo-reader)}})))])))


Remove identity monad transformer.

Remove identity monad transformer.

Is completelly useless.


Add docstrings for keypath, must, and nthpath

--- src/clj/com/rpl/specter.cljc
+++ src/clj/com/rpl/specter.cljc
@@ -794,10 +794,21 @@
                                       next-val))
                             structure)))))

-(def keypath (eachnav n/keypath*))
-(def must (eachnav n/must*))
-(def nthpath (eachnav n/nthpath*))
-
+(def ^{:doc "Navigate to the specified keys one after another. If navigate to NONE,
+             that element is removed from the map or vector."}
+  keypath
+  (eachnav n/keypath*))
+
+(def ^{:doc "Navigate to the specified keys one after another, only if they exist
+             in the data structure. If navigate to NONE, that element is removed
+             from the map or vector."}
+  must
+  (eachnav n/must*))
+
+(def ^{:doc "Navigate to the specified indices one after another.If navigate to
+            NONE, that element is removed from the sequence."}
+  nthpath
+  (eachnav n/nthpath*))

 (defrichnav
   ^{:doc "Navigates to result of running `afn` on the currently navigated value."}


Use JNDI to find the data source

Use JNDI to find the data source

--- src/clj/hyphen_keeper/db.clj
+++ src/clj/hyphen_keeper/db.clj
@@ -2,7 +2,7 @@
   "Persistence for the hyphenation dictionary"
   (:require [yesql.core :refer [defqueries]]))

-(def ^:private db "jdbc:mysql://localhost:3306/hyphenation?user=hyphenation&serverTimezone=UTC")
+(def ^:private db {:name "java:jboss/datasources/old-productions"})

 (defqueries "hyphen_keeper/queries.sql" {:connection db})


finish grant creation

finish grant creation

--- src/clj_money/web/grants.clj
+++ src/clj_money/web/grants.clj
@@ -14,20 +14,23 @@
             [clj-money.validation :as validation]
             [clj-money.inflection :refer [humanize]]
             [clj-money.models.entities :as entities]
+            [clj-money.models.users :as users]
             [clj-money.models.grants :as grants])
   (:use [clj-money.web.shared :refer :all]))

 (defn- grant-row
   [grant]
-  [:tr
-   [:td (:email grant)]
-   [:td (:email grant)]])
+  (let [user (users/find-by-id (env :db) (:user-id grant))]
+    [:tr
+     [:td (users/full-name user)]
+     [:td (:email user)]]))

 (defn index
   [{{entity :entity} :params}]
   (with-layout (format "User grants for entity %s" (:name entity)) {}
-    ; TODO apply scope
-    (let [grants (grants/search (env :db) {:entity-id (:id entity)})]
+    (let [grants (grants/search
+                   (env :db)
+                   (apply-scope {:entity-id (:id entity)} :grant))]
       [:div.row
        [:div.col-md-6
         [:table.table.table-striped
@@ -55,7 +58,8 @@
             [:label
              [:input {:type "checkbox"
                       :name (permission-key resource-type action)
-                      :checked (grants/has-permission grant resource-type action)}]
+                      :checked (grants/has-permission grant resource-type action)
+                      :value 1}]
              (humanize action)]])
          grants/actions)]])

@@ -74,6 +78,9 @@
                       (authorize :new))))
   ([{{entity :entity} :params} grant]
    (with-layout (format "User grants for entity %s" (:name entity)) {}
+     (when (validation/has-error? grant)
+       [:div.alert.alert-danger
+        (prn-str (validation/error-messages grant))])
      [:div.row
       [:div.col-md-6
        (form (format "/entities/%s/grants" (:id entity)) {}
@@ -84,13 +91,31 @@

 (defn- extract-permissions
   [params]
-  (throw (RuntimeException. "Not implemented")))
+  (->> grants/resource-types
+       (mapcat (fn [resource-type]
+                 (map #(hash-map :resource-type resource-type
+                                 :action %) grants/actions)))
+       (map #(assoc % :key (keyword (permission-key (:resource-type %)
+                                                    (:action %)))))
+       (map #(assoc % :value ((:key %) params)))
+       (filter #(= "1" (:value %)))
+       (reduce (fn [m {:keys [resource-type action]}]
+                 (update-in m
+                           [resource-type]
+                           #((fnil conj []) % action)))
+               {})))
+
+(defn- find-or-create-user
+  [email]
+  (or (users/find-by-email (env :db) email)
+      (throw (RuntimeException. "create user not implemented"))))

 (defn create
   [{params :params}]
   (let [grant (-> params
-                  (select-keys [:entity-id :user-id])
-                  (assoc extract-permissions params)
+                  (select-keys [:entity-id])
+                  (assoc :permissions (extract-permissions params)
+                         :user-id (:id (find-or-create-user (:email params))))
                   (tag-resource :grant)
                   (authorize :create))
         result (grants/create (env :db) grant)]


Refactoring on API call functions

Refactoring on API call functions

--- src/cljs/todogo_cljs/db.cljs
+++ src/cljs/todogo_cljs/db.cljs
@@ -16,58 +16,88 @@
    :todo            nil})

+(defn api-call [method url data handler]
+  (method
+    (str "http://localhost:8080" url)
+    {:format :json
+     :params data
+     :headers {:Auth-Token (.getItem (.-localStorage js/window) "token")}
+     :handler handler
+     :error-handler (fn [r] (cond
+                              (< (:status r) 400) (handler r)
+                              ;(= (:status r) 403) (set! (.-location js/window) "/login")
+                              (= (:status r) 403) (print "Access denied")
+                              (> (:status r) 500) (print (:error r))))}))
+
+
 (defn get-todo-lists []
-  (GET "/api/v1/list/"
-       {:handler (fn [data] (dispatch [:set-todo-lists (keywordize-keys data)]))}))
+  (api-call
+    GET
+    "/api/v1/list/"
+    {}
+    (fn [data] (dispatch [:set-todo-lists (keywordize-keys data)]))))

 (defn get-todo-list [list-id]
-  (GET (str "/api/v1/list/" list-id "/")
-       {:handler (fn [data] (dispatch [:set-todo-list (keywordize-keys data)]))}))
+  (api-call
+    GET
+    (str "/api/v1/list/" list-id "/")
+    {}
+    (fn [data] (dispatch [:set-todo-list (keywordize-keys data)]))))

 (defn get-todos [id]
-  (GET (str "/api/v1/list/" id "/todo/")
-       {:handler (fn [data] (dispatch [:set-todos (keywordize-keys data)]))}))
+  (api-call
+    GET
+    (str "/api/v1/list/" id "/todo/")
+    {}
+    (fn [data] (dispatch [:set-todos (keywordize-keys data)]))))

 (defn get-todo [list-id id]
-  (GET (str "/api/v1/list/" list-id "/todo/" id "/")
-       {:handler (fn [data] (dispatch [:set-todo (keywordize-keys data)]))}))
+  (api-call
+    GET
+    (str "/api/v1/list/" list-id "/todo/" id "/")
+    {}
+    (fn [data] (dispatch [:set-todo (keywordize-keys data)]))))

-(defn create-todo-list [ data]
-  (POST (str "/api/v1/list/")
-        {:format        :json
-         :params        data
-         :handler       (fn [] (do (dispatch [:set-todo-list-title ""])
-                                            (get-todo-lists)))
-         :error-handler (fn [r] (prn r))}))
+(defn create-todo-list [data]
+  (api-call
+    POST
+    (str "/api/v1/list/")
+    data
+    (fn [] (do (dispatch [:set-todo-list-title ""]) (get-todo-lists)))))

 (defn create-todo [list-id data]
-  (POST (str "/api/v1/list/" list-id "/todo/")
-        {:format        :json
-         :params        data
-         :handler       (fn [] (do (dispatch [:set-todo-title ""])
-                                            (get-todos list-id)))
-         :error-handler (fn [r] (prn r))}))
+  (api-call
+    POST
+    (str "/api/v1/list/" list-id "/todo/")
+    data
+    (fn [] (do (dispatch [:set-todo-title ""]) (get-todos list-id)))))

 (defn toggle-todo [todo]
-  (PUT (str "/api/v1/list/" (:todo_list_id todo) "/todo/" (:id todo) "/")
-        {:format        :json
-         :params        {:title (:title todo)
-                         :completed (if (= (:completed todo) true) false true)
-                         :note (:note todo)}
-         :handler       (fn [] (get-todos (:todo_list_id todo)))
-         :error-handler (fn [r] (prn r))}))
+  (api-call
+    PUT
+    (str "/api/v1/list/" (:todo_list_id todo) "/todo/" (:id todo) "/")
+    {:title (:title todo)
+     :completed (if (= (:completed todo) true) false true)
+     :note (:note todo)}
+    (fn [] (get-todos (:todo_list_id todo)))))

 (defn update-todo [todo]
-  (PUT (str "/api/v1/list/" (:todo_list_id todo) "/todo/" (:id todo) "/")
-        {:format        :json
-         :params        todo
-         :handler       (fn [] (get-todos (:todo_list_id todo)))
-         :error-handler (fn [r] (prn r))}))
+  (api-call
+    PUT
+    (str "/api/v1/list/" (:todo_list_id todo) "/todo/" (:id todo) "/")
+    todo
+    (fn [] (get-todos (:todo_list_id todo)))))

 (defn delete-todo-list [todo-list-id]
-  (DELETE (str "/api/v1/list/" todo-list-id "/")
-          {:handler (fn [] (get-todo-lists))}))
+  (api-call
+    DELETE
+    (str "/api/v1/list/" todo-list-id "/")
+    {}
+    (fn [] (get-todo-lists))))

 (defn delete-todo [todo-list-id todo-id]
-  (DELETE (str "/api/v1/list/" todo-list-id "/todo/" todo-id "/")
-          {:handler (fn [] (get-todos todo-list-id))}))
+  (api-call
+    DELETE
+    (str "/api/v1/list/" todo-list-id "/todo/" todo-id "/")
+    {}
+    (fn [] (get-todos todo-list-id))))


remove needless println

remove needless println

--- src/clojure/cljam/sorter.clj
+++ src/clojure/cljam/sorter.clj
@@ -91,7 +91,6 @@
   "Returns sorting order of the sam as String. Returning order is one of the
   following: \"queryname\", \"coordinate\", \"unsorted\", \"unknown\"."
   [rdr]
-  (println (io/read-header rdr))
   (if-let [so (:SO (:HD (io/read-header rdr)))]
     so
     order-unknown))


Use the component API to extract the connection.

--- src/cmr/graph/rest/route.clj
+++ src/cmr/graph/rest/route.clj
@@ -1,5 +1,6 @@
 (ns cmr.graph.rest.route
   (:require
+   [cmr.graph.components.neo4j :as neo4j]
    [cmr.graph.health :as health]
    [cmr.graph.rest.handler :as handler]
    [reitit.ring :as ring]
@@ -23,7 +24,7 @@

 (defn movie-demo
   [httpd-component]
-  (let [conn (get-in httpd-component [:neo4j :conn])]
+  (let [conn (neo4j/get-conn httpd-component)]
     [["/demo/movie/graph/:limit" {:get (handler/movie-demo-graph conn)}]
      ["/demo/movie/search" {:get (handler/movie-demo-search conn)}]
      ["/demo/movie/title/:title" {:get (handler/movie-demo-title conn)}]]))


add default port for remote connection (#304)

* add default port for remote connection

* update

* update

* update

* fix

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -1857,26 +1857,6 @@
   [driver]
   (util/connectable? (:host @driver)
                      (:port @driver)))
-
-(defn discover-port
-  "Finds a port for a driver type.
-
-  Takes a default one from `defaults` map. If it's already taken,
-  continues to take random ports until if finds non-busy one.
-
-  Arguments:
-
-  - `type`: a keyword, browser type (:chrome, :firefox, etc),
-
-  - `host`: a string, hostname or IP.
-
-  Returns a port as an integer."
-  [type host]
-  (loop [port (or (get-in defaults [type :port])
-                  (util/get-free-port))]
-    (if (util/connectable? host port)
-      (recur (util/get-free-port))
-      port)))

 ;;
 ;; predicates
@@ -2913,13 +2893,15 @@
   -- `:locator` is a string determs what algorithm to use by default
   when finding elements on a page. `default-locator` variable is used
   if not passed."
-  [type & [opt]] ;; todo move port and host to create-driver
+  [type & [{:keys [port host locator]}]]
   (let [driver  (atom {})
-        host    (or (:host opt) "127.0.0.1")
-        port    (or (:port opt)
-                    (discover-port type host))
+        port    (or port
+                    (if host
+                      (get-in defaults [type :port])
+                      (util/get-free-port)))
+        host    (or host "127.0.0.1")
         url     (make-url host port)
-        locator (or (:locator opt) default-locator)]
+        locator (or locator default-locator)]
     (swap! driver assoc
            :type type
            :host host
@@ -2989,9 +2971,15 @@
                      path-browser
                      driver-log-level]}]]

-  (let [{:keys [type port]} @driver
-        log-level           (or log-level :all)
-        path-driver         (or path-driver (get-in defaults [type :path]))
+  (let [{:keys [type port host]} @driver
+
+        _ (when (util/connectable? host port)
+            (throw (ex-info
+                     (format "Port %d already in use" port)
+                     {:port port})))
+
+        log-level   (or log-level :all)
+        path-driver (or path-driver (get-in defaults [type :path]))

         _ (swap! driver drv/set-browser-log-level log-level)
         _ (swap! driver drv/set-path path-driver)
@@ -3146,7 +3134,7 @@
   `run-driver` and `connect-driver` may accept."
   ([type]
    (boot-driver type {}))
-  ([type {host :host :as opt}]
+  ([type {:keys [host] :as opt}]
    (cond-> type
      true       (create-driver opt)
      (not host) (run-driver opt)


117 q-expand

117 q-expand

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -422,91 +422,96 @@
     (:value resp)))

 ;;
-;; find element(s)
-;;
-
-(defn q-expand
+;; Finding element(s)
+;;
+
+(defmulti find-element* dispatch-driver)
+
+(defmethod find-element* :firefox
+  [driver locator term]
+  (with-resp driver :post
+    [:session (:session @driver) :element]
+    {:using locator :value term}
+    resp
+    (-> resp :value first second)))
+
+(defmethod find-element* :default
+  [driver locator term]
+  (with-resp driver :post
+    [:session (:session @driver) :element]
+    {:using locator :value term}
+    resp
+    (-> resp :value :ELEMENT)))
+
+(defmulti find-elements* dispatch-driver)
+
+(defmethod find-elements* :default
+  [driver locator term]
+  (with-resp driver :post
+    [:session (:session @driver) :elements]
+    {:using locator :value term}
+    resp
+    (->> resp :value (mapv (comp second first)))))
+
+(defmulti find-element-from* dispatch-driver)
+
+(defmethod find-element-from* :firefox
+  [driver el locator term]
+  (with-resp driver :post
+    [:session (:session @driver) :element el :element]
+    {:using locator :value term}
+    resp
+    (-> resp :value first second)))
+
+(defmethod find-element-from* :default
+  [driver el locator term]
+  (with-resp driver :post
+    [:session (:session @driver) :element el :element]
+    {:using locator :value term}
+    resp
+    (-> resp :value :ELEMENT)))
+
+(defmulti find-elements-from* dispatch-driver)
+
+(defmethod find-elements-from* :default
+  [driver el locator term]
+  (with-resp driver :post
+    [:session (:session @driver) :element el :elements]
+    {:using locator :value term}
+    resp
+    (->> resp :value (mapv (comp second first)))))
+
+;;
+;; Querying elements (high-level API)
+;;
+
+(defmulti q-expand
   "Expands a query expression into a pair of `[locator, term]` values
   to pass them into low-level HTTP API. Throws a Slingshot exception
   in case of unsupported clause."
-  [driver q]
+  type)
+
+(defmethod q-expand clojure.lang.Keyword
+  [q]
+  (q-expand {:id q}))
+
+(defmethod q-expand java.lang.String
+  [q]
+  (q-expand {:xpath q}))
+
+(defmethod q-expand clojure.lang.IPersistentMap
+  [{:keys [xpath css] :as q}]
   (cond
-    (keyword? q)
-    [locator-xpath (xpath/expand {:id q})]
-
-    (string? q)
-    [(:locator @driver) q]
-
-    (and (map? q) (:xpath q))
-    [locator-xpath (:xpath q)]
-
-    (and (map? q) (:css q))
-    [locator-css (:css q)]
-
-    (map? q)
-    [locator-xpath (xpath/expand q)]
-
-    :else
-    (throw+ {:type :etaoin/query
-             :q q
-             :driver @driver
-             :message "Unsupported query clause"})))
-
-(defmulti find-element* dispatch-driver)
-
-(defmethod find-element* :firefox
-  [driver locator term]
-  (with-resp driver :post
-    [:session (:session @driver) :element]
-    {:using locator :value term}
-    resp
-    (-> resp :value first second)))
-
-(defmethod find-element* :default
-  [driver locator term]
-  (with-resp driver :post
-    [:session (:session @driver) :element]
-    {:using locator :value term}
-    resp
-    (-> resp :value :ELEMENT)))
-
-(defmulti find-elements* dispatch-driver)
-
-(defmethod find-elements* :default
-  [driver locator term]
-  (with-resp driver :post
-    [:session (:session @driver) :elements]
-    {:using locator :value term}
-    resp
-    (->> resp :value (mapv (comp second first)))))
-
-(defmulti find-element-from* dispatch-driver)
-
-(defmethod find-element-from* :firefox
-  [driver el locator term]
-  (with-resp driver :post
-    [:session (:session @driver) :element el :element]
-    {:using locator :value term}
-    resp
-    (-> resp :value first second)))
-
-(defmethod find-element-from* :default
-  [driver el locator term]
-  (with-resp driver :post
-    [:session (:session @driver) :element el :element]
-    {:using locator :value term}
-    resp
-    (-> resp :value :ELEMENT)))
-
-(defmulti find-elements-from* dispatch-driver)
-
-(defmethod find-elements-from* :default
-  [driver el locator term]
-  (with-resp driver :post
-    [:session (:session @driver) :element el :elements]
-    {:using locator :value term}
-    resp
-    (->> resp :value (mapv (comp second first)))))
+    xpath [locator-xpath xpath]
+    css [locator-css css]
+    :else [locator-xpath (xpath/expand q)]))
+
+#_(defmethod q-expand :default
+  [q] ;; todo
+  (throw+ {:type :etaoin/query
+           :q q
+           :driver @driver
+           :message "Unsupported query clause"}))

 (defn query
   "Finds an element on a page.
@@ -548,12 +553,12 @@
       (if (empty? q-rest)
         el
         (let [q (first q-rest)
-              [loc term] (q-expand driver q)]
+              [loc term] (q-expand q)]
           (recur (find-element-from* driver el loc term)
                  (rest q-rest)))))

     :else
-    (let [[loc term] (q-expand driver q)]
+    (let [[loc term] (q-expand q)]
       (find-element* driver loc term))))

 (defn query-all
@@ -573,12 +578,12 @@
     (let [q-but-last (vec (butlast q))
           q-last (last q)
           el (query driver q-but-last)
-          [loc term] (q-expand driver q-last)]
+          [loc term] (q-expand q-last)]

       (find-elements-from* driver el loc term))

     :else
-    (let [[loc term] (q-expand driver q)]
+    (let [[loc term] (q-expand q)]
       (find-elements* driver loc term))))

 ;;
@@ -1733,7 +1738,7 @@
   ([driver text]
    (has-text? driver {:tag :*} text))
   ([driver q text]
-   (let [[locator term] (q-expand driver q)
+   (let [[locator term] (q-expand q)
          term1 (format "%s[contains(text(), \"%s\")]" term text)
          term2 (format "%s//*[contains(text(), \"%s\")]" term text)]
      (when-not (= locator locator-xpath)


improved code formatting

improved code formatting

--- src/distillery/view/word.clj
+++ src/distillery/view/word.clj
@@ -12,8 +12,9 @@

 (defn- render-statistic
   [{:keys [video word] :as args}]
-  (ulist "word_statistic" [(list-item (str "Vorkommen: " (count (in-video-occurrences video word))))
-           (list-item (format "Mittlere Erkennungssicherheit: %1.1f%%" (* 100 (:mean-confidence word)) "%"))]))
+  (ulist "word_statistic"
+         [(list-item (str "Vorkommen: " (count (in-video-occurrences video word))))
+          (list-item (format "Mittlere Erkennungssicherheit: %1.1f%%" (* 100 (:mean-confidence word)) "%"))]))

 (defn- render-phrases
   [{:keys [video word] :as args}]


Kill tuples-to-hash with fire.

Kill tuples-to-hash with fire.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -117,21 +117,16 @@
   {"my" ((get types "_player"))})

 (defn name-into-objs [objs]
-  (tuples-to-hash (map (fn [{k 0 v 1}]
-                         [k (if (and (contains? v :name) (str/blank? (:name v)))
-                              (assoc v :name k)
-                              v)])
-                       objs)))
+  (into {} (map (fn [[k v]]
+                  (let [v (if (and (contains? v :name) (str/blank? (:name v)))
+                            (assoc v :name k)
+                            v)]
+                    [k v]))
+                objs)))

 (defn extract-by-class [ctx clazz]
-  (tuples-to-hash (filter
-                   (fn [x] (= clazz (class (val x))))
+  (into {} (filter (fn [x] (= clazz (class (val x))))
                    ctx)))
-
-(defn tuples-to-hash [seq-]
-  (reduce (fn [hash el] (assoc hash (get el 0) (get el 1)))
-          {}
-          seq-))

 (defn creturn
   ([story] {:sto story :out nil})


Cleanup: drop unnecessary verbosity in component definition

--- src/flense_demo/sidebar.cljs
+++ src/flense_demo/sidebar.cljs
@@ -116,6 +116,6 @@
           (for [[desc keyset] (keybinds document)
                 :let [enabled? (try (boolean ((keymap keyset) document))
                                  (catch :default _ false))]]
-            (dom/tr #js {:className (if enabled? "enabled" "disabled")}
+            (dom/tr {:class (if enabled? "enabled" "disabled")}
               (dom/td (keyset->keyname keyset))
               (dom/td desc))))))))


Oops, this never compiled

Oops, this never compiled

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -85,7 +85,8 @@

 (defn code-length [code]
   (count (remove #(or (Character/isWhitespace %)
-                      (= % \,)))))
+                      (= % \,))
+                 code)))

 (defn record-golf-score! [user-id problem-id score]
   (let [user-score-key (keyword (str "scores." problem-id))


added where filter for find-book handler

--- src/granger/models/books.clj
+++ src/granger/models/books.clj
@@ -21,7 +21,9 @@
   "Returns book review for a given ISBN"
   [isbn]
   (mongo/with-mongo conn
-    (response (mongo/fetch-one :test :as :json))))
+    (response (mongo/fetch-one :test
+                               :as :json
+                               :where {:isbn isbn}))))

 (defn find-books
   "Returns a collection of book reviews"


remove proof method (qed) step is enough for direct term. (broken in transient state)

--- src/latte/core.clj
+++ src/latte/core.clj
@@ -306,21 +306,11 @@

 (defn try-proof
-  "Provides a proof of theorem named `thm-name` using the given proof `method`
-  and `steps`.
-  There are for now two proof methods available:
-    - the `:term` method with one step: a direct proof/lambda-term
-      inhabiting the theorem/type (based on the proof-as-term, proposition-as-type
-      correspondances). This is a low-level proof method.
-
-    - the `:script` method with a declarative proof script. It is a high-level
-  (human-readable) proof method. A low-level proof term is
-  synthetized from the script
-
+  "Provides a proof of theorem named `thm-name` using the given proof `steps`.
   This version only checks if the proof is correct or not, use the [[proof]] function
-for actually registering the proof."
+  for actually registering the proof."
   {:style/indent [2 :form :form [1]]}
-  [thm-name method & steps]
+  [thm-name & steps]
   (let [def-env defenv/empty-env
         [status thm] (if (symbol? thm-name)
                        (let [[status', thm] (defenv/fetch-definition def-env thm-name)]
@@ -333,27 +323,18 @@
                              :thm-name thm-name}])]
     (if (= status :ko)
       [:failed thm]
-      (let [[status infos] (p/check-proof def-env (reverse (:params thm)) thm-name (:type thm) method steps)]
+      (let [[status infos] (p/check-proof def-env (reverse (:params thm)) thm-name (:type thm) steps)]
         (if (= status :ko)
           (do ;; (println "infos = " infos)
             [:failed thm-name infos])
-          (let [new-thm (assoc thm :proof [method steps])]
+          (let [new-thm (assoc thm :proof steps)]
             ;; (alter-var-root (resolve thm-name) (fn [_] new-thm))
             [:qed thm-name]))))))

 (defn proof
-  "Provides a proof of theorem named `thm-name` using the given proof `method`
-  and `steps`.
-  There are for now two proof methods available:
-    - the `:term` method with one step: a direct proof/lambda-term
-      inhabiting the theorem/type (based on the proof-as-term, proposition-as-type
-      correspondances). This is a low-level proof method.
-
-    - the `:script` method with a declarative proof script. It is a high-level
-  (human-readable) proof method. A low-level proof term is
-  synthetized from the script"
+  "Provides a proof of theorem named `thm-name` using the given proof `steps`."
   {:style/indent [2 :form :form [1]]}
-  [thm-name method & steps]
+  [thm-name & steps]
   (let [def-env defenv/empty-env
         [status thm] (if (symbol? thm-name)
                        (let [[status', thm] (defenv/fetch-definition def-env thm-name)]
@@ -366,12 +347,12 @@
                              :thm-name thm-name}])]
     (when (= status :ko)
       (throw (ex-info (:msg thm) (dissoc thm :msg))))
-    (let [[status infos] (p/check-proof def-env (reverse (:params thm)) thm-name (:type thm) method steps)]
+    (let [[status infos] (p/check-proof def-env (reverse (:params thm)) thm-name (:type thm) steps)]
       (if (= status :ko)
         (do ;; (println "infos = " infos)
-            (throw (ex-info (str "Proof failed: " (:msg infos)) {:theorem thm-name
-                                                                 :error (dissoc infos :msg)})))
-        (let [new-thm (assoc thm :proof [method steps])]
+          (throw (ex-info (str "Proof failed: " (:msg infos)) {:theorem thm-name
+                                                               :error (dissoc infos :msg)})))
+        (let [new-thm (assoc thm :proof steps)]
           (alter-var-root (resolve thm-name) (fn [_] new-thm))
           [:qed thm-name])))))


more debug

more debug

--- src/latte/prop.clj
+++ src/latte/prop.clj
@@ -562,15 +562,11 @@
       (have <d> _
             :by (or-elim H3 (or (or A B) C)
                          <b> <c>))
-      ;;[:print '<d> {:norm false}]
-      ;;[:print-type '<d> {:norm true}]
-      [:print-def '<b> {}]
-      [:print-def '<d> {}]
+      ;;[:print-def '<d> {:delta false}]
+      [:print-defenv {:delta false}]
       )
-    [:print-def '<b> {}]
-    [:print-def '<d> {}]
-    ;;[:print '<b> {:norm true}]
-    ;;[:print-type '<b> {:norm true}]
+    ;[:print-def '<d> {:delta false}]
+    [:print-defenv {:delta false}]
     (have <e> _
           :by (or-elim H1 (or (or A B) C)
                        <a> <d>))


Update writer.clj

Update writer.clj


wait for start time before showing start time

--- frontend/components/build_head.cljs
+++ frontend/components/build_head.cljs
@@ -200,7 +200,8 @@
                       [:a {:href (str "mailto:" (:author_email build))}
                        (build-model/author build)])]
                [:th "Started"]
-               [:td (om/build common/updating-duration {:start (:start_time build)} {:opts {:formatter datetime/time-ago}}) " ago"]]
+               [:td (when (:start_time build)
+                      (om/build common/updating-duration {:start (:start_time build)} {:opts {:formatter datetime/time-ago}}) " ago")]]
               [:tr
                [:th "Trigger"]
                [:td (build-model/why-in-words build)]


fix typo/encoding

fix typo/encoding

--- src/main/shadow/core_ext.clj
+++ src/main/shadow/core_ext.clj
@@ -1,11 +1,11 @@
-(ns shadow.core-ext)
-
-(defn safe-pr-str
-  "cider globally sets *print-length* for the nrepl-session which messes with pr-str when used to print cache or other files"
-  [x]
-  (binding [*print-length* nil
-            *print-level* nil
-            *print-namespaced-maps* nil
-            *print-meta* nil]
-    (pr-str x)
-    ))
+(ns shadow.core-ext)
+
+(defn safe-pr-str
+  "cider globally sets *print-length* for the nrepl-session which messes with pr-str when used to print cache or other files"
+  [x]
+  (binding [*print-length* nil
+            *print-level* nil
+            *print-namespace-maps* nil
+            *print-meta* nil]
+    (pr-str x)
+    ))


Cometd publish can deliver primitives

Cometd publish can deliver primitives

--- lib/compojure/cometd/cometd.clj
+++ lib/compojure/cometd/cometd.clj
@@ -1,14 +1,44 @@
 ;; An interface to Jetty's cometd implementation
-(ns compojure.cometd)
+(ns compojure.cometd
+  (:import (org.mortbay.cometd.continuation ContinuationCometdServlet)
+           (dojox.cometd MessageListener)))

-(import '(org.mortbay.cometd.continuation ContinuationCometdServlet))
+(def *cometd*
+  (new ContinuationCometdServlet))

-(def cometd-servlet
-  (new ContinuationCometdServlet))
+;;;; Sending and receiving
+
+(defn new-client
+  ([]   (new-client "compojure"))
+  ([id] (new-client *cometd* id))
+  ([servlet id]
+    (.. servlet (getBayeux)
+                (newClient id))))

 (defn- get-channel
   "Gets a cometd channel that we can publish or subscribe to."
-  [channel]
-  (.. cometd-servlet
-      (getBayeux)
-      (getChannel channel true)))
+  [servlet channel]
+  (.. servlet (getBayeux)
+              (getChannel channel true)))
+
+(defn publish
+  "Publish a message to a channel."
+  ([channel message]
+    (publish (new-client) channel message))
+  ([client channel message]
+    (publish *cometd* client channel message))
+  ([servlet client channel message]
+    (.publish (get-channel servlet channel) client message nil)))
+
+(defn subscribe
+  "Subscribe to a channel."
+  ([channel func]
+    (subscribe *cometd* channel func))
+  ([servlet channel func]
+    (let [client (new-client)]
+      (.addListener client
+        (proxy [MessageListener] []
+          (deliver [from to mesg]
+            (func mesg))))
+      (.subscribe (get-channel servlet channel) client))))
+


Refer to environ.core explicitly

Refer to environ.core explicitly

--- src/regarde/db.clj
+++ src/regarde/db.clj
@@ -1,10 +1,11 @@
 (ns regarde.db
   (:require [korma.db :as sql]
             [ragtime.core :refer [connection migrate-all applied-migrations]]
-            [ragtime.sql.files]))
+            [ragtime.sql.files]
+            [environ.core]))

 (defn db-name [env]
-  (if-let [env-database (env :database-url)]
+  (if-let [env-database (environ.core/env :database-url)]
     env-database
     (str "jdbc:postgresql://localhost:5432/"
          (cond


Remove more indirection to simplify things

--- src/reply/core.clj
+++ src/reply/core.clj
@@ -4,8 +4,7 @@
   (:require [reply.printing])
   (:import [scala.tools.jline.console ConsoleReader]
            [scala.tools.jline.console.history FileHistory]
-           [java.io File
-                    PrintWriter]))
+           [java.io File]))

 ; TODO: allow multi-line input
 (defn actual-read [input request-prompt request-exit]
@@ -13,13 +12,6 @@
     (clojure.main/repl-read request-prompt request-exit)))

 (def main-thread (Thread/currentThread))
-(def jline-reader (atom nil))
-
-(defn handle-ctrl-c [signal]
-  (println "^C")
-  (.interrupt main-thread)
-  (-> (.getCursorBuffer @jline-reader)
-      (.clear)))

 (defn make-reader []
   (let [reader (ConsoleReader.)
@@ -29,37 +21,38 @@
       (.setBellEnabled false)
       (.setHistory history))))

-(defn interpret-input [input request-prompt request-exit]
-  (cond (not input)
-          request-exit
-        (= :interrupt-caught input)
-          request-prompt
-        (= :found-old-interrupt input)
-          ""
-        (every? #(Character/isWhitespace %) input)
-          request-prompt
-        :else
-          (actual-read input request-prompt request-exit)))
+(def jline-reader (make-reader))
+
+(defn handle-ctrl-c [signal]
+  (println "^C")
+  (.interrupt main-thread)
+  (-> (.getCursorBuffer jline-reader)
+      (.clear)))

 (defn jline-read [request-prompt request-exit]
   (try
-    (.setPrompt @jline-reader (format "%s=> " (ns-name *ns*)))
-    (let [input (.readLine @jline-reader)]
-      (interpret-input input request-prompt request-exit))
+    (.setPrompt jline-reader (format "%s=> " (ns-name *ns*)))
+    (let [input (.readLine jline-reader)]
+      (cond (not input)
+              request-exit
+            (every? #(Character/isWhitespace %) input)
+              request-prompt
+            :else
+              (do
+                (Thread/interrupted) ; just to clear the status
+                (actual-read input request-prompt request-exit))))
     (catch InterruptedException e
-      (-> (.getCursorBuffer @jline-reader)
+      (-> (.getCursorBuffer jline-reader)
           (.clear))
       (request-prompt))))

 (defn -main [& args]
   (set-break-handler! handle-ctrl-c)

-  (reset! jline-reader (make-reader))
-
   (repl :read jline-read
         :prompt (constantly ""))

-  (.flush (.getHistory @jline-reader))
+  (.flush (.getHistory jline-reader))

   (shutdown-agents))


rename misaki.util.seq variable

rename misaki.util.seq variable

--- src/misaki/util/sequence.clj
+++ src/misaki/util/sequence.clj
@@ -7,8 +7,8 @@
   "Sort post list with org.joda.time.DateTime"
   ([posts]
    (sort-by-date :desc posts))
-  ([order posts]
-   (let [f? (if (= :inc order) before? after?)]
+  ([order-key posts]
+   (let [f? (if (= :inc order-key) before? after?)]
      (sort #(f? (:date %) (:date %2)) posts))))

 ; =sort-alphabetically
@@ -16,7 +16,7 @@
   "Sort list alphabetically."
   ([ls]   (sort-alphabetically :inc identity ls))
   ([f ls] (sort-alphabetically :inc f ls))
-  ([order f ls]
-   (let [f? (if (= :desc order) pos? neg?)]
+  ([order-key f ls]
+   (let [f? (if (= :desc order-key) pos? neg?)]
      (sort #(f? (compare (f %) (f %2))) ls))))


dont keep generations in memory when running from cli

--- src/search/cli.clj
+++ src/search/cli.clj
@@ -53,4 +53,4 @@
     (-> options
       (select-keys (keys search/Search))
       search/search->generations
-      doall)))
+      dorun)))


Implement svg transform/matrix attribute calculation.

--- src/uxbox/svg.cljs
+++ src/uxbox/svg.cljs
@@ -1,17 +1,78 @@
-(ns uxbox.svg)
+(ns uxbox.svg
+  "A svg related utils."
+  (:require [cuerdas.core :as str]
+            [uxbox.matrix :as mtx]
+            [uxbox.math :as mth]
+            [uxbox.util.data :refer (without-keys)]))

-(defn translate
-  [x y]
-  (str "translate(" x "," y ")"))
+(defn translate-matrix
+  ([x]
+   (translate-matrix x x))
+  ([x y]
+   (mtx/matrix [[1 0 x]
+                [0 1 y]
+                [0 0 1]])))

-(defn rotate
-  [d]
-  (str "rotate(" d ")"))
+(defn scale-matrix
+  ([w]
+   (scale-matrix w w))
+  ([w h]
+   (mtx/matrix [[w 0 0]
+                [0 h 0]
+                [0 0 1]])))

-(defn transform
-  [{:keys [center] :as opts}]
-  (let [r (get opts :rotate 0)
-        {:keys [x y]} center]
-    (str (translate x y)
-         (rotate r)
-         (translate (- x) (- y)))))
+(defn rotation-matrix
+  [^number degrees]
+  (let [v1 (mth/cos (mth/radiants degrees))
+        v2 (mth/sin (mth/radiants degrees))
+        v3 (mth/neg v2)]
+    (mtx/matrix [[v1 v3 0]
+                 [v2 v1 0]
+                 [0 0 1]])))
+
+(defn apply-translate
+  [{:keys [x y]}]
+  (translate-matrix x y))
+
+(defn apply-scale
+  [{:keys [width height view-box]}]
+  (if (and width height)
+    (let [orig-width (nth view-box 2)
+          orig-height (nth view-box 3)
+          scale-x (/ width orig-width)
+          scale-y (/ height orig-height)]
+      (scale-matrix scale-x scale-y))
+    (scale-matrix 1 1)))
+
+(defn apply-rotation
+  [{:keys [rotation x y width height view-box] :or {rotation 0}}]
+  (let [width (nth view-box 2)
+        height (nth view-box 3)
+        x (- width (/ width 2))
+        y (- height (/ height 2))]
+    (mtx/multiply (translate-matrix x y)
+                  (rotation-matrix rotation)
+                  (translate-matrix (- x)
+                                    (- y)))))
+
+(def interpret-attrs (juxt apply-translate
+                           apply-scale
+                           apply-rotation))
+
+(defn calculate-transform
+  [attrs]
+  (let [result (->> (interpret-attrs attrs)
+                    (apply mtx/multiply)
+                    (deref)
+                    (take 6)
+                    (flatten))]
+    (->> (map #(nth result %) [0 3 1 4 2 5])
+         (str/join ",")
+         (str/format "matrix(%s)"))))
+
+(defn apply-transform
+  [attrs]
+  (let [transform (calculate-transform attrs)]
+    (-> attrs
+        (without-keys [:rotation :width :height :x :y :view-box])
+        (assoc :transform transform))))


update fft ugen docstring

update fft ugen docstring

--- src/overtone/sc/ugen/fft.clj
+++ src/overtone/sc/ugen/fft.clj
@@ -11,8 +11,9 @@
               {:name "active", :default 1}
               {:name "winsize", :default 0}],
        :rates #{:kr}
-       :doc "fast fourier transform, converts input data from the time to the frequency domain and
-            stores the result in a buffer (audio waveform -> graph equalizer bands)"}
+       :doc "fast fourier transform, converts input data from the time to the frequency domain and stores the result in a buffer (audio waveform -> graph equalizer bands)
+
+Output is -1 except when an FFT frame is ready, when the output is the buffer index. This creates a special kind of slower pseudo-rate (built on top of control rate) which all the pv-ugens understand."}

       {:name "IFFT",
        :args [{:name "buffer"}


Fix #163 Another case where only the first channel of a multi-channel Inst is audible.

* Thanks to Roger Allen for catching this bug.

--- src/overtone/studio/inst.clj
+++ src/overtone/studio/inst.clj
@@ -88,9 +88,7 @@
                  *constants* #{}]
          (with-overloaded-ugens
            (let [form# ~@ugen-form
-                 n-chans# (if (seq? form#)
-                            (count form#)
-                            1)
+		 n-chans# (if (coll? form#) (count form#) 1)
                  inst-bus# (or (:bus (get (:instruments @studio*) ~sname)) (audio-bus n-chans#))
                  [ugens# constants#] (gather-ugens-and-constants (out inst-bus# form#))
                  ugens# (topological-sort-ugens ugens#)


Add capsules and cones

Add capsules and cones

--- src/play_clj/g3d_physics.clj
+++ src/play_clj/g3d_physics.clj
@@ -5,8 +5,8 @@
   (:import [com.badlogic.gdx.math Matrix4]
            [com.badlogic.gdx.physics.bullet Bullet]
            [com.badlogic.gdx.physics.bullet.collision btBoxShape
-            btCollisionDispatcher btCylinderShape btCollisionObject
-            btDefaultCollisionConfiguration btDbvtBroadphase
+            btCollisionDispatcher btCylinderShape btCapsuleShape btConeShape
+            btCollisionObject btDefaultCollisionConfiguration btDbvtBroadphase
             btSphereShape]
            [com.badlogic.gdx.physics.bullet.dynamics btDiscreteDynamicsWorld
             btDynamicsWorld btRigidBody btRigidBody$btRigidBodyConstructionInfo
@@ -176,6 +176,34 @@
   "Calls a single method on a `box-shape`."
   [object k & options]
   `(u/call! ^btBoxShape ~object ~k ~@options))
+
+(defn capsule-shape*
+  [radius height]
+  (btCapsuleShape. radius height))
+
+(defmacro capsule-shape
+  "Returns a btCapsuleShape."
+  [radius height & options]
+  `(u/calls! ^btCapsuleShape (capsule-shape* ~radius ~height) ~@options))
+
+(defmacro capsule-shape!
+  "Calls a single method on a `capsule-shape`."
+  [object k & options]
+  `(u/call! ^btCapsuleShape ~object ~k ~@options))
+
+(defn cone-shape*
+  [radius height]
+  (btConeShape. radius height))
+
+(defmacro cone-shape
+  "Returns a btConeShape."
+  [radius height & options]
+  `(u/calls! ^btConeShape (cone-shape* ~radius ~height) ~@options))
+
+(defmacro cone-shape!
+  "Calls a single method on a `cone-shape`."
+  [object k & options]
+  `(u/call! ^btConeShape ~object ~k ~@options))

 (defn cylinder-shape*
   [half-extents]


'delete post' controller

'delete post' controller

--- src/blaagh/controllers.clj
+++ src/blaagh/controllers.clj
@@ -89,3 +89,10 @@
         :title (:title (:params request))
         :content (:content (:params request))})
     (redirect "/admin/posts"))
+
+(defn edit-post-delete!
+    "Deletes a post in the DB, then redirects to /admin/posts"
+    [request]
+    (db/delete-post! {
+        :id (:post_id (:params request))})
+    (redirect "/admin/posts"))


Adapt code to buddy-core changes.

Adapt code to buddy-core changes.

--- src/buddy/sign/compact.clj
+++ src/buddy/sign/compact.clj
@@ -28,6 +28,7 @@
   transfer, is not really good candidate for auth token
   because of not good space efficiency for small messages."
   (:require [buddy.core.codecs :as codecs]
+            [buddy.core.bytes :as bytes]
             [buddy.core.keys :as keys]
             [buddy.core.mac.hmac :as hmac]
             [buddy.core.mac.poly1305 :as poly]
@@ -85,7 +86,7 @@
   (let [input (serialize data compress)
         salt (nonce/random-nonce 8)
         stamp (codecs/long->bytes (timestamp-millis))
-        signature (-> (codecs/concat-byte-arrays input salt stamp)
+        signature (-> (bytes/concat input salt stamp)
                       (calculate-signature key alg))
         result (str/join "." [(codecs/bytes->safebase64 input)
                               (codecs/bytes->safebase64 signature)
@@ -108,7 +109,7 @@
         signature (codecs/safebase64->bytes signature)
         salt (codecs/safebase64->bytes salt)
         stamp (codecs/safebase64->bytes stamp)
-        candidate (codecs/concat-byte-arrays input salt stamp)]
+        candidate (bytes/concat input salt stamp)]
     (if (verify-signature candidate signature key alg)
       (either/right (nippy/thaw input {:v1-compatibility? false}))
       (either/left "Invalid signature."))))


Remove debug statement

Remove debug statement

--- src/catalog/layout/obi.clj
+++ src/catalog/layout/obi.clj
@@ -33,7 +33,6 @@

 (defn- level-sexp [items path path-to-numbers]
   (let [level (count path)]
-    (println level (last path))
     [(level-keyword level)
      [(heading-keyword level)
       (format "%s%s"


use core.async/map for channel fapply

use core.async/map for channel fapply

--- src/cats/labs/channel.cljc
+++ src/cats/labs/channel.cljc
@@ -79,13 +79,7 @@
       (a/to-chan [(if (nil? v) ::nil v)]))

     (-fapply [mn af av]
-      (let [c (a/chan 1)]
-        (go
-          (let [af' (a/<! (a/into [] af))
-                av' (a/<! (a/into [] av))
-                ctx (p/-get-context [])]
-            (a/onto-chan c (p/-fapply ctx af' av'))))
-        c))
+      (a/map #(%1 %2) [af av]))

     p/Monad
     (-mreturn [_ v]


Removes unnecessary "to" to messages.

Removes unnecessary "to" to messages.

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -212,7 +212,7 @@

    "Ashigaru"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (count (:hand corp)) " subroutines")}
+                 :msg (msg "gain " (count (:hand corp)) " subroutines")}
                 end-the-run]}

    "Assassin"
@@ -241,7 +241,7 @@

    "Brainstorm"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (count (:hand runner)) " subroutines")}
+                 :msg (msg "gain " (count (:hand runner)) " subroutines")}
                 (do-brain-damage 1)]}

    "Builder"
@@ -590,13 +590,13 @@

    "Information Overload"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (:tag runner 0) " subroutines")}
+                 :msg (msg "gain " (:tag runner 0) " subroutines")}
                 (tag-trace 1)
                 trash-installed]}

    "Ireress"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (:bad-publicity corp 0) " subroutines")}
+                 :msg (msg "gain " (:bad-publicity corp 0) " subroutines")}
                 {:msg "make the Runner lose 1 [Credits]"
                  :effect (effect (lose :runner :credit 1))}]}

@@ -619,7 +619,7 @@

    "Komainu"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (count (:hand runner)) " subroutines")}
+                 :msg (msg "gain " (count (:hand runner)) " subroutines")}
                 (do-net-damage 1)]}

    "Lab Dog"
@@ -731,7 +731,7 @@

    "NEXT Silver"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (count (filter #(and (is-type? % "ICE")
+                 :msg (msg "gain " (count (filter #(and (is-type? % "ICE")
                                                            (has-subtype? % "NEXT")
                                                            (rezzed? %))
                                                      (all-installed state :corp))) " subroutines")}
@@ -791,7 +791,7 @@
    "Salvage"
    {:advanceable :while-rezzed
     :abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (:advance-counter card 0) " subroutines")}
+                 :msg (msg "gain " (:advance-counter card 0) " subroutines")}
                 (tag-trace 2)]}

    "Searchlight"
@@ -877,7 +877,7 @@
    {:effect take-bad-pub
     :advanceable :always
     :abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (:advance-counter card 0) " subroutines")}
+                 :msg (msg "gain " (:advance-counter card 0) " subroutines")}
                 trash-program]}

    "Swordsman"
@@ -906,7 +906,7 @@

    "Tour Guide"
    {:abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (count (filter #(and (is-type? % "Asset") (rezzed? %))
+                 :msg (msg "gain " (count (filter #(and (is-type? % "Asset") (rezzed? %))
                                                      (all-installed state :corp))) " subroutines")}
                 end-the-run]}

@@ -939,7 +939,7 @@
    "Tyrant"
    {:advanceable :while-rezzed
     :abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (:advance-counter card 0) " subroutines")}
+                 :msg (msg "gain " (:advance-counter card 0) " subroutines")}
                 end-the-run]}

    "Universal Connectivity Fee"
@@ -1020,7 +1020,7 @@
    "Woodcutter"
    {:advanceable :while-rezzed
     :abilities [{:label "Gain subroutines"
-                 :msg (msg "to gain " (:advance-counter card 0) " subroutines")}
+                 :msg (msg "gain " (:advance-counter card 0) " subroutines")}
                 (do-net-damage 1)]}

    "Wormhole"


Now utility function

Now utility function

--- src/cljs/db_quiz/util.cljs
+++ src/cljs/db_quiz/util.cljs
@@ -18,6 +18,11 @@
                    (fn [event] (put! out event)))
     out))

+(defn now
+  "Returns current time in seconds"
+  []
+  (/ (.getTime (js/Date.)) 1000))
+
 (def number-of-fields
   (apply + (range (inc (:board-size config)))))


having stuff on one line each results in better source matching while debugging / performance optimizing

--- src/clojure/flambo/api.clj
+++ src/clojure/flambo/api.clj
@@ -532,13 +532,16 @@
   (-> rdd
       ^JavaPairRDD
       (map-to-pair identity)
-      (.cogroup (map-to-pair other identity))
+      (.cogroup
+        (map-to-pair other identity))
       (map seqify-untuple-2)))
   ([^JavaPairRDD rdd ^JavaPairRDD other1 ^JavaPairRDD other2]
    (-> rdd
        ^JavaPairRDD
        (map-to-pair identity)
-       (.cogroup (map-to-pair other1 identity) (map-to-pair other2 identity))
+       (.cogroup
+         (map-to-pair other1 identity)
+         (map-to-pair other2 identity))
        (map seqify-untuple-3))))


Fix phantom starting

Fix phantom starting

--- src/export_server/core.clj
+++ src/export_server/core.clj
@@ -232,8 +232,7 @@
   (if (sharing/init options)
     (timbre/info "Sharing initialiazed")
     (timbre/warn "Sharing did not initialize. Provide both twitter-* and sharing-* options."))
-  (when (:allow-scripts-executing options)
-    (browser/setup-phantom))
+  (browser/setup-phantom)
   (state/set-server! (run-server app {:port (:port options) :ip (:host options)}))
   (.addShutdownHook (Runtime/getRuntime) (Thread. shutdown-server)))


Comment tweak.

Comment tweak.

--- test/ago/test.cljs
+++ test/ago/test.cljs
@@ -546,7 +546,7 @@
             (assert (= (<! ch0) nil))
             (assert (= (<! ch1) nil))

-            (ago-restore agw ss2) ; Restore something ss2, or a future snapshot.
+            (ago-restore agw ss2) ; Restore ss2, i.e., a future snapshot.
             (>! cc0 true)
             (assert (= (<! ch0) 5))
             (>! cc0 true)


more diagnostics

more diagnostics

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -103,18 +103,19 @@
                (not (= (get-in parent [:synsem :cat])
                        (get-in child [:synsem :cat]))))
                :fail
-            (unify (copy parent)
-                   (unify {:head (copy child)
-                           :head-filled true}
-                          {:head {:synsem {:sem (lexfn-sem-impl (copy (get-in child '(:synsem :sem) :top)))}}})))]
+               (unify
+                (merge
+                 (copy parent)
+                 {:surface (str
+                            (get-in parent [:rule]) " -> " (get-in child [:surface]) "")})
+                 (unify {:head (copy child)
+                         :head-filled true}
+                        {:head {:synsem {:sem (lexfn-sem-impl (copy (get-in child '(:synsem :sem) :top)))}}})))]
       (if (not (fail? result))
         (let [debug (log/trace (str "moreover-head: " (get-in parent '(:rule)) " succeeded: " (get-in result [:rule])
                                     ":'" (morph result) "'"))
-              debug (log/debug (str "moreover-head: [" (get-in parent [:rule]) " H: "
-                                    (if (get-in child [:rule])
-                                      (get-in child [:rule])
-                                      (get-in child [:surface]))
-                                    "]"))
+              debug (log/debug (str "moreover-head: pass:     " (strip-refs (get-in parent [:rule])) " -> "
+                                    "[" (get-in child [:surface]) "]"))
               debug (log/trace (str " resulting sem: " (strip-refs (get-in result '(:synsem :sem)))))]
           result)

@@ -138,12 +139,17 @@
                               (get-in parent (concat [:head] fail-path))))
               (log/trace (str "    head@" fail-path "="
                               (get-in child fail-path)))))
-          (log/debug (str "moreover-head: fail: parent: " (strip-refs (get-in parent [:rule])) ";"
-                          "child [" (get-in child [:surface]) "]; cat: " (get-in child [:synsem :cat])))
           (if (and (not (= (get-in parent [:synsem :cat])
                            (get-in child [:synsem :cat])))
                    (not *check-parent-and-head-child-cat-equal*))
             (log/warn (str "moreover-head: CHILD CAT DIFFERS FROM HEAD CAT!")))
+          (if (= (get-in parent [:synsem :cat])
+                 (get-in child [:synsem :cat]))
+            (log/debug (str "moreover-head: failcat== " (strip-refs (get-in parent [:rule])) "; "
+                            "child: " (get-in child [:surface]) ""))
+            (log/debug (str "moreover-head: failcat!= " (strip-refs (get-in parent [:rule])) "; "
+                            "child: " (get-in child [:surface]) "")))
+
           :fail)))))

 ;; Might be useful to set the following variable to true,
@@ -161,24 +167,33 @@
                  (not (= (get-in parent [:comp :synsem :cat])
                          (get-in child [:synsem :cat]))))
           :fail
-          (unify (copy parent)
-                 (unifyc {:comp child}
-                         {:comp {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}})))]
+          (unify
+           (merge
+            (copy parent)
+            ;; TODO: don't merge this in: surface-calculation should happen on-demand, not in this
+            ;; time-critical code. i.e. build surface of tree by doing a depth-first traversal, not
+            ;; storing stuff within tree in case someone is interested.
+            {:surface (str
+                       ""
+                       (get-in parent [:surface]) " " (get-in child [:surface]) "")})
+           (unifyc {:comp child}
+                   {:comp {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}})))]
     (if (not (fail? result))
-      (let [debug (log/debug (str "moreover-comp: [" (get-in parent [:rule]) " C: "
-                                  (if (get-in child [:rule])
-                                    (get-in child [:rule])
-                                    (get-in child [:synsem :cat]))
-                                  "]"))]
+      (let [debug (log/debug (str "moreover-comp: pass:     "
+                                  "[" (get-in parent [:surface]) "];" " child ["
+                                  (get-in child [:surface]) "]"))]
+
         (let [result
               (merge {:comp-filled true}
                      result)]
           result))
+      ;; else: fail:
       (do
         (log/trace (str "moreover-comp: fail: " result))
         (log/trace (str "moreover-comp: fail at: " (fail-path result)))
-        (log/debug (str "moreover-comp: fail: parent: " (strip-refs (get-in parent [:rule])) ";"
-                        "child cat: " (get-in child [:synsem :cat])))
+        (log/debug (str "moreover-comp: fail:     "
+                        "[" (get-in parent [:surface]) "];" " child ["
+                        (get-in child [:surface]) "]"))
         (log/trace (str "moreover-comp: fail: child: " (strip-refs child)))
         (if (and
              *throw-exception-if-failed-to-add-complement*


cleanup

cleanup

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -53,10 +53,8 @@
                (overc parent comp))
              parents))

-   (vector? comp)
-   (overc parent (lazy-seq comp))
-
-   (seq? comp)
+   (or (seq? comp)
+       (vector? comp))
    (let [comp-children comp]
      (mapcat (fn [child]
                (overc parent child))
@@ -95,31 +93,6 @@
              (overhc parent head comp)))
          parents)))

-(defn morph-with-recovery [morph-fn input]
-  (if (nil? input)
-    (exception (str "don't call morph-with-recovery with input=nil.")))
-  (if (nil? morph-fn)
-    (exception (str "don't call morph-with-recovery with morph-fn=nil.")))
-  (let [result (morph-fn input)
-        result (if (or (nil? result)
-                       (= "" result))
-                 (get-in input [:english :english] "")
-                 result)
-        result (if (or (nil? result)
-                       (= "" result))
-                 (get-in input [:english] "")
-                 result)
-        result (if (or (nil? result)
-                       (= "" result))
-                 (get-in input [:rule] "")
-                 result)
-        result (if (or (nil? result)
-                       (= "" result))
-                 (exception
-                  (str "r5: " input "/" (nil? input)))
-                 result)]
-    result))
-
 (defn show-bolt [bolt language-model]
   (if (nil? bolt)
     (exception (str "don't call show-bolt with bolt=null."))
@@ -127,7 +100,7 @@
       (if (nil? morph)
         (exception (str "don't call show-bolt with morph=null."))
         (str "[" (get-in bolt [:rule])
-             " '" (morph-with-recovery morph bolt) "'"
+             " "
              (let [head-bolt (get-in bolt [:head])]
                (if (not (nil? head-bolt))
                  (let [rest-str (show-bolt (get-in bolt [:head]) language-model)]


more selective copying using (unify (copy)) rather than (unifyc)

--- src/babel/over.cljc
+++ src/babel/over.cljc
@@ -4,7 +4,7 @@
    [clojure.string :as string]
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
-   [dag_unify.core :refer [fail? fail-path get-in merge strip-refs unifyc]]
+   [dag_unify.core :refer [copy fail? fail-path get-in merge strip-refs unify unifyc]]
    [babel.lexiconfn :refer [get-fail-path sem-impl]]))

 (defn exception [error-string]
@@ -90,14 +90,16 @@
       (log/trace (str "over-each-comp-child: done. returning nil."))
       nil)))

+(def ^:dynamic *extra-diagnostics* false)
+
 (defn moreover-head [parent child lexfn-sem-impl morph]
   (let [morph (if morph morph (fn [x] x))]
     (log/trace (str "moreover-head (candidate) parent: [" (get-in parent [:rule]) "] '" (morph parent) "' sem:    " (strip-refs (get-in parent '(:synsem :sem) :no-semantics))))
     (log/trace (str "moreover-head (candidate) head child: [" (get-in parent [:child]) "] '" (morph child) "' sem:" (strip-refs (get-in child '(:synsem :sem) :top))))
     (let [result
-          (unifyc parent
-                  (unifyc {:head child}
-                          {:head {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}}))]
+          (unify (copy parent)
+                 (unify {:head (copy child)}
+                        {:head {:synsem {:sem (lexfn-sem-impl (copy (get-in child '(:synsem :sem) :top)))}}}))]
       (if (not (fail? result))
         (let [debug (log/trace (str "moreover-head: " (get-in parent '(:rule)) " succeeded: " (get-in result [:rule])
                                     ":'" (morph result) "'"))
@@ -141,9 +143,9 @@
   (log/debug (str "moreover-comp type comp:" (type child)))

   (let [result
-        (unifyc parent
-                (unifyc {:comp child}
-                        {:comp {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}}))]
+        (unify (copy parent)
+               (unifyc {:comp child}
+                       {:comp {:synsem {:sem (lexfn-sem-impl (get-in child '(:synsem :sem) :top))}}}))]

     (if (not (fail? result))
       (let [debug (log/debug (str "moreover-comp added parent to child: " (get-in parent [:rule])))]


Whitespace.

Whitespace.


Data Validation and Annotations

Data Validation and Annotations

# Removes 3d form the name of movies.
# :imdb-name contains proper name for querying omdb api.
# Async requests with http-kit and core-async for faster data fetching
from omdb.

--- src/cine/server.clj
+++ src/cine/server.clj
@@ -7,8 +7,52 @@
             [hiccup.core :as h]
             [ring.middleware.defaults :refer :all]
             [cheshire.core :as cheshire ]
+            [org.httpkit.client :as http]
+            [clojure.core.async :as a :refer [go <! >! <!! >!!]]
             [cine.core :as cine])
   (:gen-class))
+
+(defn add-3d-info [mov]
+  (if (.contains (str/lower-case (:name mov)) "3d")
+    (assoc mov :3d true)
+    (assoc mov :3d false)))
+
+(defn strip-x-from-name
+  "Strips 'x' from name where 'x' is a string or char-sequence or regexp"
+  [mov x]
+  (str/replace mov x ""))
+
+(defn list-movies []
+  (->> (cine/mapify-current-movies)
+       (map add-3d-info)
+       (map #(assoc % :name (strip-x-from-name (:name %) "(3D)")))
+       (map #(assoc % :name (strip-x-from-name (:name %) "(2D)")))
+       (map #(assoc % :imdb-name (-> (:name %)
+                                     (str/trim)
+                                     (str/replace "-" "")
+                                     (str/replace "  " " ")
+                                     (str/replace " " "+"))))
+       ;; (map #(assoc % :imdb-name (str/replace
+       ;;                             (str/replace
+       ;;                               (str/trim (:name %)) "-" "") " " "+")))
+       ))
+
+(list-movies)
+
+(defn http-get [url]
+  (let [c (a/chan)]
+    (http/get url #(a/put! c %))
+    c))
+
+(time (dotimes [n 10]
+        (<!! (http-get "http://www.omdbapi.com?t=Selma"))))
+(time (let [chans (doall (for [x (list-movies)]
+                           (http-get (str "http://www.omdbapi.com/?t=" (:name x)))))]
+        (for [c chans]
+          (<!! c))))
+
+
+(time (doall (pmap #(client/get (str "http://www.omdbapi.com/?t=" (:name %))) (list-movies))))

 (defn current-movie-list-handler [req]
   {:status 200


Convert ObjectIds to Ruby.

Convert ObjectIds to Ruby.

--- src/circle/ruby.clj
+++ src/circle/ruby.clj
@@ -6,7 +6,7 @@
   (:require fs)
   (:use midje.sweet))

-(declare eval ruby)
+(declare eval ruby get-class get-module)

 (defn new-runtime []
   (let [config (doto (org.jruby.RubyInstanceConfig.)
@@ -90,6 +90,10 @@
   (org.jruby.RubyString/newString (ruby) s))

 (defmethod ->ruby
+  org.bson.types.ObjectId [id]
+  (send (get-class (get-module "BSON") "ObjectId") :from_string (.toString id)))
+
+(defmethod ->ruby
   java.lang.Float [n]
   (org.jruby.RubyFloat. (ruby) n))

@@ -115,6 +119,8 @@
   nil [n]
   (-> (ruby) (.getNil)))

+(def sample-objectid-string "4ee6911fe4b05e6a4d3605fe")
+
 (fact "conversions work"
   (->ruby nil) => (eval "nil")
   (->ruby "a string") => (eval "'a string'")
@@ -126,6 +132,7 @@
   (->ruby [5 6 7]) => (eval "[5, 6, 7]")
   (->ruby {5 6}) => (eval "{5 => 6}")
   (class (eval ":foo")) => org.jruby.RubySymbol
+  (->ruby (org.bson.types.ObjectId. sample-objectid-string)) => (eval (format "BSON::ObjectId::from_string '%s'" sample-objectid-string))

   ;; complex nested structures
   (->ruby [:foo "bar" 5 nil]) => (eval "[:foo, 'bar', 5, nil]")


Convert invalid tokens to string by default.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -68,13 +68,23 @@
   [opts]
   (let [cmds (opts :cmds)
         err-fn (opts :print-err)
+        invalid-token-to-string (opts :invalid-token-to-string)
         quit-commands (conj (:quit (get-cmd-aliases cmds)) :quit)]
     (fn [request-prompt request-exit]
       (try
         (or ({:line-start request-prompt :stream-end request-exit}
              (skip-whitespace *in*))
             (loop [v []]
-              (let [input (read {:read-cond :allow} *in*)]
+              (let [input (try
+                            (read {:read-cond :allow} *in*)
+                            (catch RuntimeException e
+                              (let [msg (.getMessage e)
+                                    invalid-msg-start "Invalid token: "]
+                              (if (and
+                                    invalid-token-to-string
+                                    (.startsWith msg invalid-msg-start))
+                                (.replace msg invalid-msg-start "")
+                                (throw e)))))]
                 (if (and (not (symbol? input)) (empty? v))
                   (do
                     (skip-if-eol *in*)
@@ -233,6 +243,7 @@
    :eval-factory create-cli-eval-fn
    :help-factory create-cli-help-fn
    :help-cmd-entry-delimiter *cli4clj-line-sep*
+   :invalid-token-to-string true
    :print cli-repl-print
    :print-err print-err-fn
    :prompt-fn (fn [])


malformed? should be the inverse of valid?

--- src/gangway/web.clj
+++ src/gangway/web.clj
@@ -14,7 +14,7 @@
   :available-media-types ["text/plain"]
   :malformed? (fn  [ctx]
                 (let [message (slurp (get-in ctx [:request :body]))]
-                  (gw-validation/valid? message)))
+                  (not (gw-validation/valid? message))))
   :handle-malformed (fn [ctx]  (prn (str "Malformed Gangway Message: " (slurp (get-in ctx [:request :body])))))
   :post! (fn incoming!- [ctx]
           (let [rp (get-in ctx [:request :route-params])


Remove old function to construct pmd datasets.

--- src/grafter/rdf.clj
+++ src/grafter/rdf.clj
@@ -177,17 +177,3 @@
 (defn context [statement]
   "Return the RDF context from a statement."
   (pr/context statement))
-
-(defn dataset [dataset-uri data-graph date title label comment description email]
-  (let [metadata-graph (str data-graph "/metadata")]
-
-    (graph metadata-graph
-           [dataset-uri
-            [rdf:a pmd:Dataset]
-            [rdfs:comment (s comment :en)]
-            [rdfs:label (s label :en)]
-            [dcterms:description (s description :en)]
-            [pmd:contactEmail email]
-            [pmd:graph data-graph]
-            [dcterms:issued date]
-            [dcterms:modified date]])))


Rename expand-subject to triplify.

Rename expand-subject to triplify.

--- src/grafter/rdf.clj
+++ src/grafter/rdf.clj
@@ -39,7 +39,7 @@
        (->sesame-rdf-type [this]
          (LiteralImpl. str lang-or-uri)))))

-(defn expand-subject
+(defn- expand-subj
   "Takes a turtle like data structure and converts it to triples e.g.

    [:rick [:a :Person]
@@ -48,3 +48,8 @@

   (map (fn [[predicate object]]
          (Triple. subject predicate object)) po-pairs))
+
+(defn triplify [& subjects]
+  "Takes many turtle like structures and converts them to a lazy-seq
+of grafter.rdf.protocols.IStatement's"
+  (mapcat expand-subj subjects))


Revision of ontology_id_denotes_object_property rule

Exclude properties that exist only in ICE world, e.g. IAO, CCP
extension ontology, OA ontology

--- resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_b/ontology_id_denotes_object_property.clj
+++ resources/rules/pre_identifier_merge/step_a_ontology_to_ice/step_b/ontology_id_denotes_object_property.clj
@@ -15,5 +15,9 @@
                   ?object_property rdfs:subPropertyOf* ?top_level_property .
                   minus {?object_property owl:deprecated true} .
                   minus {?object_property rdf:type ccp:IAO_EXT_0000308} # ccp:top-level object property identifier
+                  # exclude ICE world properties (IAO, CCP extension ontology, OA ontology)
+                  filter (!contains (str(?object_property), 'ext/IAO_'))
+                  filter (!contains (str(?object_property), 'obo/IAO_'))
+                  filter (!contains (str(?object_property), 'http://www.w3.org/ns/oa#'))
                   }"
   }


Starter edition

Starter edition

--- src/korhal/core.clj
+++ src/korhal/core.clj
@@ -1,22 +1,8 @@
 (ns korhal.core
   (:require [korhal.interop.interop :refer :all]
-            [korhal.strategy.engine :refer [start-strategy-engine! stop-strategy-engine!
-                                            strategy-inform! strategy-expire!
-                                            strategy-remove!]]
-            [korhal.macro.engine :refer [start-macro-engine! stop-macro-engine!]]
-            [korhal.macro.state :refer [builder-to-constructor!
-                                        construction-completed!]]
-            [korhal.micro.engine :refer [start-micro-engine! stop-micro-engine!
-                                         micro-tag-new-unit!]]
             [korhal.tools.util :refer [swap-key swap-keys profile]]
             [korhal.tools.repl :refer :all]
-            [korhal.tools.queue :refer :all]
-            [korhal.tools.contract :refer [available-minerals available-gas
-                                           contract-build contracted-max-supply
-                                           clear-contracts cancel-contracts
-                                           show-contract-display clear-contract-atoms
-                                           can-build? contract-add-initial-cc
-                                           contract-add-new-building]])
+            [korhal.tools.queue :refer :all])
   (:import (clojure.lang.IDeref)
            (jnibwapi.JNIBWAPI)
            (jnibwapi.BWAPIEventListener)))
@@ -49,31 +35,52 @@
   (println "Game Started")
   (enable-user-input)
   (set-game-speed 10)
-  (load-map-data true)
-  (draw-targets true)
-  (draw-ids true)
-  (show-contract-display true)
-  (start-repl! 7777))
+  (load-map-data true))
+
+(defn can-afford? [unit-kw]
+  (let [unit-type (get-unit-type (unit-type-kws unit-kw))]
+    (and (>= (my-minerals) (mineral-price unit-type))
+         (>= (my-gas) (gas-price unit-type))
+         (>= (- (my-supply-total) (my-supply-used))
+             (supply-required unit-type)))))

 (defn korhal-gameUpdate [this]
-  ;; we have to do this here instead of korhal-gameStarted because frame does not
-  ;; get reset to 0 until now when restarting a game
-  (when (zero? (frame-count))
-    (clear-contract-atoms)
-    (contract-add-initial-cc)
-    (start-strategy-engine!)
-    (start-macro-engine!)
-    (start-micro-engine!))
-  (strategy-expire! :nukes 250) ;; estimated frames for a nuke to drop
-  (clear-contracts)
-  (execute-api-queue)
-  (execute-repl-queue))

-(defn korhal-gameEnded [this]
-  (stop-strategy-engine!)
-  (stop-macro-engine!)
-  (stop-micro-engine!)
-  (stop-repl!))
+  ;; start mining
+  (doseq [drone (filter idle? (my-drones))]
+    (let [dist-to-drone (fn [mineral] (dist drone mineral))
+          closest-mineral (apply min-key dist-to-drone (minerals))]
+      (right-click drone closest-mineral)))
+
+  ;; build up to 6 drones
+  (when (and (can-afford? :drone)
+             (< (my-supply-used) 6))
+    (let [larva (first (my-larvae))]
+      (morph larva :drone)))
+
+  ;; build spawning pool with one of those drones
+  (when (and (can-afford? :spawning-pool)
+             (zero? (count (my-spawning-pools))))
+    (let [drone (first (filter completed? (my-drones)))
+          hatchery (first (my-hatcheries))
+          tx (if (< (tile-x hatchery) 40) (+ 5 (tile-x hatchery)) (- (tile-x hatchery) 5))
+          ty (tile-y hatchery)]
+      (build drone tx ty :spawning-pool)))
+
+  ;; build zerglings
+  (when (and (can-afford? :zergling)
+             (not (empty? (filter completed? (my-spawning-pools)))))
+    (let [larva (first (my-larvae))]
+      (morph larva :zergling)))
+
+  ;; rush the shit out of them
+  (let [enemy-base (first (enemy-start-locations))]
+    (doseq [zergling (filter idle? (my-zerglings))]
+      (attack zergling (pixel-x enemy-base) (pixel-y enemy-base))))
+
+  )
+
+(defn korhal-gameEnded [this])

 (defn korhal-keyPressed [this keycode])

@@ -82,62 +89,28 @@

 (defn korhal-receiveText [this text])

-(defn korhal-nukeDetect [this x y]
-  (strategy-inform! :nukes {:x x :y y :frame (frame-count)}))
+(defn korhal-nukeDetect [this x y])

 (defn korhal-playerLeft [this player-id])

-(defn korhal-unitCreate [this unit-id]
-  (let [unit (get-unit-by-id unit-id)]
-    (when (my-unit? unit)
-      (if (building? unit)
-        (do (builder-to-constructor! unit)
-            (contract-add-new-building unit))
-        (micro-tag-new-unit! unit)))))
+(defn korhal-unitCreate [this unit-id])

-(defn korhal-unitDestroy [this unit-id]
-  ;; NOTE: destroyed units are no longer available through the API
-  (cancel-contracts unit-id)
-  (strategy-remove! :enemy-units unit-id))
+(defn korhal-unitDestroy [this unit-id])

-(defn korhal-unitDiscover [this unit-id]
-  (let [unit (get-unit-by-id unit-id)]
-    (when (not (my-unit? unit))
-      (strategy-inform! :enemy-units {:id unit-id
-                                      :type (get-unit-type unit)
-                                      :x (pixel-x unit)
-                                      :y (pixel-y unit)
-                                      :frame (frame-count)}))))
+(defn korhal-unitDiscover [this unit-id])

 (defn korhal-unitEvade [this unit-id])

 (defn korhal-unitHide [this unit-id])

-(defn korhal-unitMorph [this unit-id]
-  (let [unit (get-unit-by-id unit-id)]
-    (when ((every-pred my-unit? is-refinery?) unit)
-      (builder-to-constructor! unit)
-      (contract-add-new-building unit))))
+(defn korhal-unitMorph [this unit-id])

-(defn korhal-unitShow [this unit-id]
-  (let [unit (get-unit-by-id unit-id)]
-    (when (not (my-unit? unit))
-      (strategy-inform! :enemy-units {:id unit-id
-                                      :type (get-unit-type unit)
-                                      :x (pixel-x unit)
-                                      :y (pixel-y unit)
-                                      :frame (frame-count)}))))
+(defn korhal-unitShow [this unit-id])

 (defn korhal-unitRenegade [this unit-id])

 (defn korhal-saveGame [this game-name])

-(defn korhal-unitComplete
-  "BUG: This does NOT get called when a morphing unit (e.g. refinery)
-  completes!"
-  [this unit-id]
-  (let [unit (get-unit-by-id unit-id)]
-    (when ((every-pred my-unit? building?) unit)
-      (construction-completed! unit))))
+(defn korhal-unitComplete [this unit-id])

 (defn korhal-playerDropped [this player-id])


remove app_test from build

remove app_test from build

--- pipeline/src/pipeline/steps.clj
+++ pipeline/src/pipeline/steps.clj
@@ -18,7 +18,7 @@
     (lambdacd-git/clone ctx repo-uri ref cwd)))

 (defn build [args ctx]
-  (shell/bash ctx (:cwd args) "docker-compose build base app_test beat worker"))
+  (shell/bash ctx (:cwd args) "docker-compose build base beat worker"))

 (defn run-python-unit-tests [args ctx]
   (shell/bash ctx (:cwd args) "docker-compose -p houseofdota_tests up --abort-on-container-exit python_unit_tests"))


fix dox

fix dox

--- src/metabase/db.clj
+++ src/metabase/db.clj
@@ -66,12 +66,12 @@

    `(upd User 123 :is_active false)` -> updates user with id=123, setting is_active=false

-   Returns newly updated entity if update modified rows, false otherwise."
+   Returns true if update modified rows, false otherwise."
   [entity entity-id & kwargs]
   (let [kwargs (->> (apply assoc {} kwargs)
                     (pre-update entity))]
     (-> (update entity (set-fields kwargs) (where {:id entity-id}))
-             (> 0))))
+        (> 0))))

 (defn del
   "Wrapper around `korma.core/delete` that makes it easier to delete a row given a single PK value.


removed backup melody

removed backup melody


Add usage to core.clj so that users will see it by `lein run`

--- src/puzzle/core.clj
+++ src/puzzle/core.clj
@@ -1,7 +1,8 @@
 (ns puzzle.core
-  (:gen-class))
+  (:gen-class)
+  (:require [puzzle.komachi :as komachi]))

 (defn -main
-  "I don't do a whole lot ... yet."
+  "Display a usage"
   [& args]
-  (println "Hello, World!"))
+  (println "Komachi Mushi Kui Zan (小町虫食い算): $ lein run -m puzzle.komachi"))


Set Kafka 'replica.fetch.max.bytes' to correct value.

--- resources/spec.clj
+++ resources/spec.clj
@@ -20,6 +20,7 @@
  :kafka {:server {:port 9090
                   :broker.id 1
                   :message.max.bytes 16777216
+                  :replica.fetch.max.bytes 16777216
                   :log.dir "target/kafka-log"
                   :zookeeper.connect "localhost"}}
  :elastic {}


CMR-1707: Removed unused namespace. Fixed indentation.

--- common-app-lib/src/cmr/common_app/api/routes.clj
+++ common-app-lib/src/cmr/common_app/api/routes.clj
@@ -7,7 +7,6 @@
             [cmr.acl.core :as acl]
             [cheshire.core :as json]
             [cmr.common.xml :as cx]
-            [clojure.string :as str]
             [cmr.common.mime-types :as mt]
             [compojure.core :refer :all]
             [ring.util.codec :as rc]))
@@ -107,11 +106,11 @@
         find-re (fn [re] (and mime-type (re-find re mime-type)))]
     (if (string? (:body response))
       (cond
-        (find-re #"application/.*json.*")(update-in response [:body]
-                                                    (fn [json-str]
-                                                      (-> json-str
-                                                          json/parse-string
-                                                          (json/generate-string {:pretty true}))))
+        (find-re #"application/.*json.*") (update-in response [:body]
+                                                     (fn [json-str]
+                                                       (-> json-str
+                                                           json/parse-string
+                                                           (json/generate-string {:pretty true}))))
         (find-re #"application/.*xml.*") (update-in response [:body] cx/pretty-print-xml)
         :else response)
       ((ring-json/wrap-json-response identity {:pretty true}) response))))


~(defn model): improve :name

~(defn model): improve :name

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -539,7 +539,7 @@
                     :lexicon lexicon))
         debug (log/info "  finalizing..")
         model
-        {:name "a small English grammar"
+        {:name "English language model created with ❤ by babel.english.grammar/model."
          :default-fn default-fn
          :index-fn (fn [spec] (lookup-spec spec indices index-lexicon-on-paths))
          ;; Will throw a clojure/core-level exception if more than 1 rule has the same :rule value:


+meeting,+party

+meeting,+party

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1241,6 +1241,10 @@
    "meet"  {:synsem {:cat :verb
                      :sem {:pred :incontrare}}
             :english {:past "met"}}
+
+   "meeting" {:synsem {:cat :noun
+                       :sem {:pred :meeting
+                             :event true}}}
    "mother"
    (unify agreement-noun
           common-noun
@@ -1356,6 +1360,11 @@

    "participate"  {:synsem {:cat :verb
                             :sem {:pred :participate}}}
+
+   "party" {:synsem {:cat :noun
+                     :sem {:pred :party
+                           :place true
+                           :event true}}}

    ;; TODO: 3sing present exception used below to avoid "playies" is not an exception: it's a rule: y->ys.
    ;; the exceptional case is when "ys" is not used (e.g. "tries").


explicitly specify [subcat 3] = () if [subcat 3] is not otherwise specified

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -3,7 +3,7 @@
   (:require
    [babel.francais.morphology :refer [exception-generator phonize]]
    [babel.francais.pos :refer :all]
-   [babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)]
+   [babel.lexiconfn :refer (compile-lex if-then map-function-on-map-vals unify)]
    [babel.pos :as pos :refer [pronoun-acc]]
    [dag-unify.core :refer [get-in]]))

@@ -705,7 +705,11 @@
               ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
               transitivize

-              ;; TODO: use lexiconfn/if-then where possible, like espanol/lexicon does.
+              (if-then {:synsem {:cat :verb
+                                 :subcat {:3 '()}}}
+                       {:synsem {:subcat {:3 '()}}})
+
+              ;; TODO: use lexiconfn/if-then here, like espanol/lexicon does.
               ;; default: essere=false
               (map-function-on-map-vals
                (fn [k vals]


changed predicate from andare to go

changed predicate from andare to go

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -39,7 +39,7 @@
             :synsem {:cat :verb
                      :essere true
                      :sem {:subj {:animate true}
-                           :pred :andare}}}
+                           :pred :go}}}

    "anoncier" {:synsem {:cat :verb
                         :sem {:pred :announce}}}


remove debug output

remove debug output

--- src/clj/lambdacd/steps/git.clj
+++ src/clj/lambdacd/steps/git.clj
@@ -129,7 +129,6 @@
         commits (parse-log log-output)
         original-out (:out args)
         new-out (str "\n\nChanges between commits:\n\n" original-out log-output)]
-    (println new-out)
     (assoc args :commits commits :out new-out)))

 (defn wait-with-details [ctx repo branch]


Toggle editor visiblity so hints don't appear when the editor is hidden

--- src/clojure/nightmod/utils.clj
+++ src/clojure/nightmod/utils.clj
@@ -89,6 +89,7 @@
     (if show?
       (.add (.getContentPane @ui/root) @editor BorderLayout/EAST)
       (.remove (.getContentPane @ui/root) @editor))
+    (.setVisible @editor show?)
     (.revalidate @ui/root)
     ; focus on the root so the game can receive keyboard events
     (when-not show?


Minify fns

Minify fns

--- src/discuss/communication.cljs
+++ src/discuss/communication.cljs
@@ -36,10 +36,8 @@
          :headers       (merge (token-header) headers)
          :error-handler error-handler})
    (lib/loading? true))
-  ([url headers]
-   (ajax-get url headers lib/update-all-states!))
-  ([url]
-   (ajax-get url {})))
+  ([url headers] (ajax-get url headers lib/update-all-states!))
+  ([url] (ajax-get url {})))

 (defn ajax-get-and-change-view
     "Make ajax call to jump right into the discussion and change to discussion view."


Fix to main startup

Fix to main startup

--- dev/src/yada/dev/main.clj
+++ dev/src/yada/dev/main.clj
@@ -16,7 +16,7 @@

            (let [system (->
                          (yada.dev.system/new-production-system)
-                         component/start-system)]
+                         com.stuartsierra.component/start-system)]

              (println "System started")
              (println "Ready...")


Improve overview page

Improve overview page

--- src/lambdacd_pipeline/core.clj
+++ src/lambdacd_pipeline/core.clj
@@ -33,7 +33,11 @@
     (compojure/context (:pipeline-url project) [] app)))

 (defn mk-link [{url :pipeline-url name :name}]
-  [:li [:a {:href (str url "/")} name]])
+  [:li
+   name
+   [:ul
+    [:li [:a {:href (str url "/reference/")} "Reference UI"]]
+    [:li [:a {:href (str url "/lambdaui/lambdaui/index.html")} "LambdaUI"]]]])

 (defn mk-index [projects]
   (h/html


added docstrings for before, after, and around macros

--- src/midje/ideas/background.clj
+++ src/midje/ideas/background.clj
@@ -43,16 +43,32 @@
             (fn [loc] (symbol-named? (zip/node loc) "?form"))
             (fn [loc] (zip/replace loc (unify/?form)))))]

-  (defmacro before [wrapping-target before-form & [_ after-form & _]]
+  (defmacro before
+    "Code to run before a given wrapping target (:facts, :contents, :checks).
+     Used with background and against-background"
+    [wrapping-target before-form & [_ after-form & _]]
     (ensure-correct-form-variable `(try
                                      ~before-form
                                      ?form
                                      (finally ~after-form))))

-  (defmacro after [wrapping-target after-form]
+  (defmacro after
+    "Code to run after a given wrapping target (:facts, :contents, :checks).
+     Used with background and against-background"
+    [wrapping-target after-form]
     (ensure-correct-form-variable `(try ?form (finally ~after-form))))

-  (defmacro around [wrapping-target around-form]
+  (defmacro around
+    "Code to run around a given wrapping target (:facts, :contents, :checks).
+     Use the symbol '?form' tp denote the code that is being wrapped around.
+
+     ex.
+     (around :contents (let [a 999]
+                         ?form
+                         (print a)))
+
+     Used with background and against-background"
+    [wrapping-target around-form]
     (ensure-correct-form-variable around-form)))

 (defn seq-headed-by-setup-teardown-form? [forms]


fix compile with posts

fix compile with posts

--- src/misaki/core.clj
+++ src/misaki/core.clj
@@ -206,7 +206,9 @@
        (post-file? file)
        (every? #(true? (first %))
                (for [file (map template-name->file (:compile-with-post *config*))]
-                 (compile* (merge optional-config {:-compiling :single}) file)))
+                 (if (index-file? file)
+                   (index-compile* (merge optional-config {:-compiling :single}) file)
+                   (compile* (merge optional-config {:-compiling :single}) file))))

        :else process-result))))


[wallet #11898] Fix disappearing tokens after adding a new account

--- src/status_im/wallet/core.cljs
+++ src/status_im/wallet/core.cljs
@@ -27,7 +27,8 @@
             status-im.wallet.recipient.core
             [status-im.ui.screens.wallet.signing-phrase.views :as signing-phrase]
             [status-im.async-storage.core :as async-storage]
-            [status-im.popover.core :as popover.core]))
+            [status-im.popover.core :as popover.core]
+            [clojure.set :as clojure.set]))

 (defn get-balance
   [{:keys [address on-success on-error]}]
@@ -326,9 +327,8 @@
                                    (flatten (map keys (vals balances))))]
     (fx/merge cofx
               (multiaccounts.update/multiaccount-update
-               :wallet/visible-tokens (assoc visible-tokens
-                                             chain
-                                             chain-visible-tokens)
+               :wallet/visible-tokens
+               (update visible-tokens chain clojure.set/union chain-visible-tokens)
                {})
               (update-tokens-balances balances)
               (prices/update-prices))))


fix duplicating the interactive layers demo

--- src/pc/http/doc.clj
+++ src/pc/http/doc.clj
@@ -4,10 +4,12 @@
             [clojure.tools.logging :as log]
             [datomic.api :as d]
             [pc.datomic :as pcd]
+            [pc.datomic.web-peer :as web-peer]
             [pc.models.chat-bot :as chat-bot-model]
             [pc.models.doc :as doc-model]
             [pc.models.layer :as layer-model])
-  (:import [java.io PushbackReader]))
+  (:import java.io.PushbackReader
+           java.util.UUID))

 (defn read-doc [doc]
   (edn/read (PushbackReader. (io/reader (io/resource (format "docs/%s.edn" doc))))))
@@ -22,10 +24,14 @@
                                                   :document/chat-bot (rand-nth chat-bot-model/chat-bots)}
                                                  (when (:cust/uuid cust) {:document/creator (:cust/uuid cust)})))]
     (if-let [layers (get (docs) document-name)]
-      @(d/transact (pcd/conn) (conj (map #(assoc %
-                                            :db/id (d/tempid :db.part/user)
-                                            :document/id (:db/id doc))
-                                         layers)
+      @(d/transact (pcd/conn) (conj (map-indexed
+                                     (fn [i l]
+                                       (let [temp-id (d/tempid :db.part/user)]
+                                         (assoc l
+                                                :db/id temp-id
+                                                :document/id (:db/id doc)
+                                                :frontend/id (UUID. (:db/id doc) (inc i)))))
+                                     layers)
                                     (merge {:db/id (d/tempid :db.part/tx)
                                             :document/id (:db/id doc)}
                                            (when (:cust/uuid cust)


Use warn method instead error for notify the user of default error handler.

--- src/potok/core.cljs
+++ src/potok/core.cljs
@@ -87,7 +87,7 @@

 (defn- default-error-handler
   [error]
-  (js/console.error "Using default error handler, consider using your own!")
+  (js/console.warn "Using default error handler, consider using your own!")
   (js/console.error error)
   (throw error))


Block current thread in setup fn until size is set for window.

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -127,14 +127,23 @@
                   :pdf    PApplet/PDF
                   :dxf    PApplet/DXF})

+(defn- wait-event-dispatch-thread
+  "Blocks current thread until all events in AWT event dispatch thread are processed."
+  []
+  (javax.swing.SwingUtilities/invokeAndWait (fn [])))
+
 (defn- applet-set-size
-  ([width height] (.size (current-applet) (int width) (int height)))
+  ([width height]
+     (.size (current-applet) (int width) (int height))
+     (wait-event-dispatch-thread))
   ([width height renderer]
      (let [renderer (resolve-constant-key renderer renderer-modes)]
-       (.size (current-applet) (int width) (int height) renderer)))
+       (.size (current-applet) (int width) (int height) renderer))
+     (wait-event-dispatch-thread))
     ([width height renderer path]
      (let [renderer (resolve-constant-key renderer renderer-modes)]
-       (.size (current-applet) (int width) (int height) renderer path))))
+       (.size (current-applet) (int width) (int height) renderer path))
+     (wait-event-dispatch-thread)))

 (defn- validate-size!
   "Checks that the size vector is exactly two elements. If not, throws