Reformat day8.re-frame-10x.db ns

Reformat day8.re-frame-10x.db ns

--- src/day8/re_frame_10x/db.cljs
+++ src/day8/re_frame_10x/db.cljs
@@ -3,25 +3,25 @@
             [day8.re-frame-10x.utils.localstorage :as localstorage]))

 (defn init-db [debug?]
-  (let [panel-width% (localstorage/get "panel-width-ratio" 0.35)
-        show-panel? (localstorage/get "show-panel" true)
-        selected-tab (localstorage/get "selected-tab" :event)
-        filter-items (localstorage/get "filter-items" [])
-        app-db-paths (into (sorted-map) (localstorage/get "app-db-paths" {}))
-        json-ml-paths (localstorage/get "app-db-json-ml-expansions" #{})
-        external-window? (localstorage/get "external-window?" false)
+  (let [panel-width%               (localstorage/get "panel-width-ratio" 0.35)
+        show-panel?                (localstorage/get "show-panel" true)
+        selected-tab               (localstorage/get "selected-tab" :event)
+        filter-items               (localstorage/get "filter-items" [])
+        app-db-paths               (into (sorted-map) (localstorage/get "app-db-paths" {}))
+        json-ml-paths              (localstorage/get "app-db-json-ml-expansions" #{})
+        external-window?           (localstorage/get "external-window?" false)
         external-window-dimensions (localstorage/get "external-window-dimensions" {:width 800 :height 800 :top 0 :left 0})
-        show-epoch-traces? (localstorage/get "show-epoch-traces?" true)
-        using-trace? (localstorage/get "using-trace?" true)
-        ignored-events (localstorage/get "ignored-events" {})
-        low-level-trace (localstorage/get "low-level-trace" {:reagent true :re-frame true})
-        filtered-view-trace (localstorage/get "filtered-view-trace" (let [id1 (random-uuid)
-                                                                          id2 (random-uuid)]
-                                                                      {id1 {:id id1 :ns-str "re-com.box" :ns 're-com.box :sort 0}
-                                                                       id2 {:id id2 :ns-str "re-com.input-text" :ns 're-com.input-text :sort 1}}))
-        num-epochs (localstorage/get "retained-epochs" 25)
-        follows-events? (localstorage/get "app-db-follows-events?" true)
-        categories (localstorage/get "categories" #{:event :sub/run :sub/create :sub/dispose})]
+        show-epoch-traces?         (localstorage/get "show-epoch-traces?" true)
+        using-trace?               (localstorage/get "using-trace?" true)
+        ignored-events             (localstorage/get "ignored-events" {})
+        low-level-trace            (localstorage/get "low-level-trace" {:reagent true :re-frame true})
+        filtered-view-trace        (localstorage/get "filtered-view-trace" (let [id1 (random-uuid)
+                                                                                id2 (random-uuid)]
+                                                                             {id1 {:id id1 :ns-str "re-com.box" :ns 're-com.box :sort 0}
+                                                                              id2 {:id id2 :ns-str "re-com.input-text" :ns 're-com.input-text :sort 1}}))
+        num-epochs                 (localstorage/get "retained-epochs" 25)
+        follows-events?            (localstorage/get "app-db-follows-events?" true)
+        categories                 (localstorage/get "categories" #{:event :sub/run :sub/create :sub/dispose})]
     (when using-trace?
       (rf/dispatch [:global/enable-tracing]))
     (rf/dispatch [:settings/panel-width% panel-width%])


CMR-5199: Allow request-id param.

CMR-5199: Allow request-id param.

--- src/cmr/exchange/query/const.clj
+++ src/cmr/exchange/query/const.clj
@@ -3,4 +3,4 @@
 (def default-format "nc")

 (def shared-keys
-  #{:collection-id :format :subset})
+  #{:collection-id :format :subset :request-id})


adjust instruction set

adjust instruction set

--- src/cljocker/hh/dsl/docker.clj
+++ src/cljocker/hh/dsl/docker.clj
@@ -3,19 +3,25 @@
             [clojure.test :refer :all]
             [clojure.set :refer :all]))

-(def DOCKER-INSTRUCTION
+(def INSTRUCTIONS
   #{:from
     :maintainer
     :run
+    :cmd
+    :label
+    :expose
     :env
     :add
-    :expose
     :copy
-    :cmd
     :entrypoint
+    :volume
     :user
     :workdir
-    :volume})
+    :arg
+    :onbuild
+    :stopsignal
+    :healthcheck
+    :shell})

 (defn instruction-concat [instruction v]
   (str
@@ -25,7 +31,7 @@

 (defn build-instruction [instruction args]
   (cond
-    (not (contains? DOCKER-INSTRUCTION instruction)) ""
+    (not (contains? INSTRUCTIONS instruction)) ""
     (vector? args) (instruction-concat instruction args)
     (function? args) (instruction-concat instruction (args))
     :else (instruction-concat instruction [args])))
@@ -42,7 +48,7 @@
        (= :from first)
        (= 0 (count (filter empty? (take-nth 2 rest))))
        (subset? (set (take-nth 2 definition))
-                DOCKER-INSTRUCTION)))
+                INSTRUCTIONS)))

 (defn docker
   ([definition]


Remove commeted code from decode function on jws ns.

--- src/clojure/buddy/sign/jws.clj
+++ src/clojure/buddy/sign/jws.clj
@@ -193,7 +193,6 @@
     (if (false? result)
       (either/left "Invalid token.")
       (let [now (to-timestamp (jodat/now))]
-        ;; (println 2222 (> now (:exp claims)))
         (cond
           (and (:exp claims) (> now (:exp claims)))
           (either/left (format "Token is older than :exp (%s)" (:exp claims)))


finish filtered-nodes

finish filtered-nodes

--- src/clojure/confgraph/core.clj
+++ src/clojure/confgraph/core.clj
@@ -13,10 +13,6 @@

 (def edges (zipmap nodes (for [x confs] (extends x))))

-(defn filtered-edges [prefix]
-  (let [e edges]
-    (for
-
 ;; memoize path-to-root
 (defn path-to-root [src]
   (let [dst (edges src)]
@@ -24,8 +20,12 @@
       {}
       (conj {src dst} (path-to-root dst)))))

-(defn edge-str [edge]
-  (str "  " (first edge) " -> " (second edge) ";"))
+(defn filtered-edges [prefix]
+  (let [re (re-pattern (str prefix ".*"))]
+    (into {} (for [[src dst] edges :when (re-matches re src)]
+               (path-to-root src)))))
+
+(defn edge-str [[src dst]] (str "  " src " -> " dst ";"))

 (defn usage []
   (println "NEED USAGE STRING HERE")


Experimental performance improvements to diffing - but doesn't help!

--- src/clojure/freactive/dom.cljs
+++ src/clojure/freactive/dom.cljs
@@ -69,27 +69,25 @@

 (declare get-transition)

-(defn- init-element-meta! [state element-spec tag attrs]
+(defn- init-element-meta! [state element-spec tag ]
   (let [m (meta element-spec)]
     (set! (.-meta state) m)
     (when-let [on-disposed (get m :node-disposed)]
       (set! (.-disposed-callback state) on-disposed)))
-  (set! (.-tag state) tag)
-  (set! (.-attrs state) attrs))
-
-(defn- reset-element-spec! [state spec tag attrs]
+  (set! (.-tag state) tag))
+
+(defn- reset-element-spec! [state spec tag]
   (when-let [on-disposed (.-disposed-callback state)]
     (on-disposed)
     (set! (.-disposed-callback state) nil))
-  (set! (.-element-spec state) spec)
-  (init-element-meta! state spec tag attrs))
-
-(defn- init-element-state! [dom-node element-spec tag attrs]
+  (set! (.-element-spec state) spec))
+
+(defn- init-element-state! [dom-node element-spec tag]
   (let [node-id (str auto-node-id)
         state (ElementState. node-id false element-spec nil)]
     (set! auto-node-id (inc auto-node-id))
     (set-attr! dom-node "data-freactive-id" node-id)
-    (init-element-meta! state element-spec tag attrs)
+    (init-element-meta! state element-spec tag)
     (aset element-state-lookup node-id state)
     (set! (.-freactive-state dom-node) state)
     state))
@@ -399,15 +397,29 @@

         :default
         (bind-prop-attr! (get-attr-setter element attr-name)
-                         element attr-name attr-value node-state))))
-
-  (defn- dispose-child-state [node-state child-key]
-    (when-let [child-states (.-child-states node-state)]
-      (when-let [state (aget child-states child-key)]
-        (set! (.-disposed state) true)
-        (when-let [disposed-callback (.-disposed-callback state)]
-          (disposed-callback))
-        (js-delete child-states child-key)))))
+                         element attr-name attr-value node-state)))))
+
+(defn- bind-attrs!* [node attrs node-state binder]
+  (let [js-attrs #js {}]
+    (doseq [[k v] attrs]
+      (binder node k v node-state)
+      (aset js-attrs (str k) v))
+    js-attrs))
+
+(defn- bind-attrs! [node attrs node-state]
+  (let [style (:style attrs)
+        js-attrs (bind-attrs!* node (dissoc attrs :style) node-state bind-attr!)
+        js-style (bind-attrs!* node style node-state bind-style-prop!)]
+    (set! (.-attrs node-state) js-attrs)
+    (set! (.-style node-state) js-style)))
+
+(defn- dispose-child-state [node-state child-key]
+  (when-let [child-states (.-child-states node-state)]
+    (when-let [state (aget child-states child-key)]
+      (set! (.-disposed state) true)
+      (when-let [disposed-callback (.-disposed-callback state)]
+        (disposed-callback))
+      (js-delete child-states child-key))))

 (defn- unbind-attr!* [node-state prefix attr-name]
   (let [attr-key (str "-" prefix "." attr-name)]
@@ -451,18 +463,32 @@
       (let [k (name k)]
         (rebind-attr! node k v node-state)))))

+;(defn- replace-attrs!* [node node-state old-attrs new-attrs rebinder]
+;  (let [hit #js {}]
+;    (doseq [[attr-name new-val] new-attrs]
+;      ;(println "rebinding" attr-name new-val)
+;      (rebinder node attr-name new-val node-state)
+;      (when (get old-attrs attr-name)
+;          (aset hit (str attr-name) true)))
+;    (doseq [[attr-name _] old-attrs]
+;      (let [attr-str (str attr-name)]
+;        (when-not (aget hit attr-str)
+;          ;(println "unbinding" attr-name)
+;          (rebinder node attr-name nil node-state))))))
+
 (defn- replace-attrs!* [node node-state old-attrs new-attrs rebinder]
-  (let [hit #js {}]
+  (let [new-attrs-js #js {}]
     (doseq [[attr-name new-val] new-attrs]
-      ;(println "rebinding" attr-name new-val)
-      (rebinder node attr-name new-val node-state)
-      (when (get old-attrs attr-name)
-          (aset hit (str attr-name) true)))
-    (doseq [[attr-name _] old-attrs]
-      (let [attr-str (str attr-name)]
-        (when-not (aget hit attr-str)
-          ;(println "unbinding" attr-name)
-          (rebinder node attr-name nil node-state))))))
+      (let [attr-str (if-let [attr-ns (namespace attr-name)]
+                       (str attr-ns "/" (name attr-name))
+                       (name attr-name))]
+        (rebinder node attr-name new-val node-state)
+        (js-delete old-attrs attr-str)
+        (aset new-attrs-js attr-str new-val)))
+    (goog.object/forEach old-attrs
+      (fn [_ attr-str _]
+        (rebinder node (keyword attr-str) nil node-state)))
+    new-attrs-js))

 ;(defn- replace-attrs!* [node node-state old-attrs new-attrs rebinder]
 ;  (loop [[[k new-val] & new-attrs] (seq new-attrs)
@@ -496,18 +522,21 @@
     (doseq [child-key to-remove]
       (js-delete child-states child-key))))

-(defn- replace-attrs! [node node-state old-attrs new-attrs]
-  (let [old-style (:style old-attrs)
+(defn- replace-attrs! [node node-state new-attrs]
+  (let [old-attrs (.-attrs node-state)
+        old-style (.-style node-state)
         new-style (:style new-attrs)]
     (dispose-attrs node-state)
-    (replace-attrs!* node node-state
-                     (dissoc old-attrs :style)
-                     (dissoc new-attrs :style)
-                     bind-attr!)
-    (replace-attrs!* node node-state
-                     old-style
-                     new-style
-                     bind-style-prop!)))
+    (set! (.-attrs node-state)
+          (replace-attrs!* node node-state
+                           old-attrs
+                           (dissoc new-attrs :style)
+                           bind-attr!))
+    (set! (.-style node-state)
+          (replace-attrs!* node node-state
+                           old-style
+                           new-style
+                           bind-style-prop!))))

 ;; From hiccup.compiler:
 (def ^{:doc "Regular expression that parses a CSS-style id and class from an element name."
@@ -552,7 +581,7 @@
 (defn- text-node? [dom-node]
   (identical? (.-nodeType dom-node) 3))

-(def enable-diffing false)
+(def enable-diffing true)

 (defn- register-element-with-parent [parent new-elem]
   (when-not (text-node? new-elem)
@@ -612,13 +641,12 @@
       (if (keyword-identical? new-tag cur-tag)
         (do
           ;(println "diff hit" (first vdom) (.-id cur-state))
-          (let [old-attrs (.-attrs cur-state)
+          (let [                                            ;;old-attrs (.-attrs cur-state)
                 new-attrs? (second vdom)
                 new-attrs (when (map? new-attrs?) new-attrs?)]
-            (reset-element-spec! cur-state vdom new-tag new-attrs)
+            (reset-element-spec! cur-state vdom new-tag)
             (replace-attrs! cur-dom-node
                             cur-state
-                            old-attrs
                             new-attrs)
             (let [new-children (if new-attrs (nnext vdom) (next vdom))
                   dangling-child (try-diff-subseq cur-dom-node (.-firstChild cur-dom-node) new-children)]
@@ -864,10 +892,11 @@
             node (create-dom-node tag)
             attrs? (second virtual-dom)
             attrs (when (map? attrs?) attrs?)
-            state (init-element-state! node elem-spec tag attrs)
+            state (init-element-state! node elem-spec tag)
             children (if attrs (nnext virtual-dom) (next virtual-dom))]
-        (doseq [[k v] attrs]
-          (bind-attr! node k v state))
+        ;(doseq [[k v] attrs]
+        ;  (bind-attr! node k v state))
+        (bind-attrs! node attrs state)
         (when children
           (append-children! node children))
         ;(when-let [m (.-meta state)]


Remove primitive type hint on variadic function

--- src/clojure/neko/threading.clj
+++ src/clojure/neko/threading.clj
@@ -54,7 +54,7 @@
 (defn post-delayed
   "Causes the macro body to be added to the message queue.  It will execute on
   the UI thread.  Returns true if successfully placed in the message queue."
-  [^View view ^long millis & body]
+  [view millis & body]
   `(post-delayed* ~view ~millis (fn [] ~@body)))

 (defn on-ui-thread?


Define <-tagged-SQLite and tagged-SQLite-to-JS to do tag-aware value transforms.

--- src/datomish/sqlite_schema.cljc
+++ src/datomish/sqlite_schema.cljc
@@ -16,6 +16,161 @@
               [cljs.core.async :as a :refer [<! >!]]])))

 (def current-version 1)
+
+(def v1-statements
+  ["CREATE TABLE datoms (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL,
+                         value_type_tag SMALLINT NOT NULL,
+                         index_avet TINYINT NOT NULL DEFAULT 0, index_vaet TINYINT NOT NULL DEFAULT 0,
+                         index_fulltext TINYINT NOT NULL DEFAULT 0,
+                         unique_value TINYINT NOT NULL DEFAULT 0, unique_identity TINYINT NOT NULL DEFAULT 0)"
+   "CREATE INDEX idx_datoms_eavt ON datoms (e, a, value_type_tag, v)"
+   "CREATE INDEX idx_datoms_aevt ON datoms (a, e, value_type_tag, v)"
+
+   ;; Opt-in index: only if a has :db/index true.
+   "CREATE UNIQUE INDEX idx_datoms_avet ON datoms (a, value_type_tag, v, e) WHERE index_avet IS NOT 0"
+
+   ;; Opt-in index: only if a has :db/valueType :db.type/ref.  No need for tag here since all
+   ;; indexed elements are refs.
+   "CREATE UNIQUE INDEX idx_datoms_vaet ON datoms (v, a, e) WHERE index_vaet IS NOT 0"
+
+   ;; Opt-in index: only if a has :db/fulltext true; thus, it has :db/valueType :db.type/string,
+   ;; which is not :db/valueType :db.type/ref.  That is, index_vaet and index_fulltext are mutually
+   ;; exclusive.
+   "CREATE INDEX idx_datoms_fulltext ON datoms (value_type_tag, v, a, e) WHERE index_fulltext IS NOT 0"
+
+   ;; TODO: possibly remove this index.  :db.unique/value should be asserted by the transactor in
+   ;; all cases, but the index may speed up some of SQLite's query planning.  For now, it services
+   ;; to validate the transactor implementation.  Note that tag is needed here, since we could have
+   ;; a keyword (stored as ":foo") that overlaps a string value ":foo".
+   "CREATE UNIQUE INDEX idx_datoms_unique_value ON datoms (value_type_tag, v) WHERE unique_value IS NOT 0"
+   ;; TODO: possibly remove this index.  :db.unique/identity should be asserted by the transactor in
+   ;; all cases, but the index may speed up some of SQLite's query planning.  For now, it serves to
+   ;; validate the transactor implementation.  Note that tag is needed here to differentiate, e.g.,
+   ;; keywords and strings.
+   "CREATE UNIQUE INDEX idx_datoms_unique_identity ON datoms (a, value_type_tag, v) WHERE unique_identity IS NOT 0"
+
+   "CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1, value_type_tag SMALLINT NOT NULL)"
+   "CREATE INDEX idx_transactions_tx ON transactions (tx)"
+
+   ;; Fulltext indexing.
+   ;; A fulltext indexed value v is an integer rowid referencing fulltext_values.
+
+   ;; Optional settings:
+   ;; tokenize="porter"
+   ;; prefix='2,3'
+   ;; By default we use Unicode-aware tokenizing (particularly for case folding), but preserve
+   ;; diacritics.
+   "CREATE VIRTUAL TABLE fulltext_values
+     USING FTS4 (text NOT NULL, tokenize=unicode61 \"remove_diacritics=0\")"
+
+   ;; A view transparently interpolating fulltext indexed values into the datom structure.
+   "CREATE VIEW fulltext_datoms AS
+     SELECT e, a, fulltext_values.text AS v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
+       FROM datoms, fulltext_values
+       WHERE datoms.index_fulltext IS NOT 0 AND datoms.v = fulltext_values.rowid"
+
+   ;; A view transparently interpolating all entities (fulltext and non-fulltext) into the datom structure.
+   "CREATE VIEW all_datoms AS
+     SELECT e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
+       FROM datoms
+       WHERE index_fulltext IS 0
+     UNION ALL
+     SELECT e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
+       FROM fulltext_datoms"
+
+   ;; Materialized views of the schema.
+   "CREATE TABLE idents (ident TEXT NOT NULL PRIMARY KEY, entid INTEGER UNIQUE NOT NULL)"
+   ;; TODO: allow arbitrary schema values (true/false) and tag the resulting values.
+   "CREATE TABLE schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value TEXT NOT NULL, FOREIGN KEY (ident) REFERENCES idents (ident))"
+   "CREATE INDEX idx_schema_unique ON schema (ident, attr, value)"
+   ])
+
+(defn <create-current-version
+  [db]
+  (->>
+    #(go-pair
+       (doseq [statement v1-statements]
+         (try
+           (<? (s/execute! db [statement]))
+           (catch #?(:clj Throwable :cljs js/Error) e
+             (throw (ex-info "Failed to execute statement" {:statement statement} e)))))
+       (<? (s/set-user-version db current-version))
+       (<? (s/get-user-version db)))
+    (s/in-transaction! db)))
+
+(defn <update-from-version
+  [db from-version]
+  {:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
+  {:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
+  (go-pair
+    (raise-str "No migrations yet defined!")
+    (<? (s/set-user-version db current-version))
+    (<? (s/get-user-version db))))
+
+(defn <ensure-current-version
+  [db]
+  (go-pair
+    (let [v (<? (s/get-user-version db))]
+      (cond
+        (= v current-version)
+        v
+
+        (= v 0)
+        (<? (<create-current-version db))
+
+        (< v current-version)
+        (<? (<update-from-version db v))))))
+
+;; This is close to the SQLite schema since it may impact the value tag bit.
+(defprotocol IEncodeSQLite
+  (->SQLite [x] "Transforms Clojure{Script} values to SQLite."))
+
+(extend-protocol IEncodeSQLite
+  #?@(:clj
+      [String
+       (->SQLite [x] x)
+
+       clojure.lang.Keyword
+       (->SQLite [x] (str x))
+
+       Boolean
+       (->SQLite [x] (if x 1 0))
+
+       Integer
+       (->SQLite [x] x)
+
+       Long
+       (->SQLite [x] x)
+
+       Float
+       (->SQLite [x] x)
+
+       Double
+       (->SQLite [x] x)]
+
+      :cljs
+      [string
+       (->SQLite [x] x)
+
+       Keyword
+       (->SQLite [x] (str x))
+
+       boolean
+       (->SQLite [x] (if x 1 0))
+
+       number
+       (->SQLite [x] x)]))
+
+(defn <-SQLite
+  "Transforms SQLite values to Clojure{Script}."
+  [valueType value]
+  (case valueType
+    :db.type/ref     value
+    :db.type/keyword (keyword (subs value 1))
+    :db.type/string  value
+    :db.type/boolean (not= value 0)
+    :db.type/long    value
+    :db.type/double  value))

 ;; Datomish rows are tagged with a numeric representation of :db/valueType:
 ;; The tag is used to limit queries, and therefore is placed carefully in the relevant indices to
@@ -32,162 +187,52 @@
    :db.type/uri     12
    :db.type/keyword 13})

-(def v1-statements
-  ["CREATE TABLE datoms (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL,
-                         value_type_tag SMALLINT NOT NULL,
-                         index_avet TINYINT NOT NULL DEFAULT 0, index_vaet TINYINT NOT NULL DEFAULT 0,
-                         index_fulltext TINYINT NOT NULL DEFAULT 0,
-                         unique_value TINYINT NOT NULL DEFAULT 0, unique_identity TINYINT NOT NULL DEFAULT 0)"
-   "CREATE INDEX idx_datoms_eavt ON datoms (e, a, value_type_tag, v)"
-   "CREATE INDEX idx_datoms_aevt ON datoms (a, e, value_type_tag, v)"
-
-   ;; Opt-in index: only if a has :db/index true.
-   "CREATE UNIQUE INDEX idx_datoms_avet ON datoms (a, value_type_tag, v, e) WHERE index_avet IS NOT 0"
-
-   ;; Opt-in index: only if a has :db/valueType :db.type/ref.  No need for tag here since all
-   ;; indexed elements are refs.
-   "CREATE UNIQUE INDEX idx_datoms_vaet ON datoms (v, a, e) WHERE index_vaet IS NOT 0"
-
-   ;; Opt-in index: only if a has :db/fulltext true; thus, it has :db/valueType :db.type/string,
-   ;; which is not :db/valueType :db.type/ref.  That is, index_vaet and index_fulltext are mutually
-   ;; exclusive.
-   "CREATE INDEX idx_datoms_fulltext ON datoms (value_type_tag, v, a, e) WHERE index_fulltext IS NOT 0"
-
-   ;; TODO: possibly remove this index.  :db.unique/value should be asserted by the transactor in
-   ;; all cases, but the index may speed up some of SQLite's query planning.  For now, it services
-   ;; to validate the transactor implementation.  Note that tag is needed here, since we could have
-   ;; a keyword (stored as ":foo") that overlaps a string value ":foo".
-   "CREATE UNIQUE INDEX idx_datoms_unique_value ON datoms (value_type_tag, v) WHERE unique_value IS NOT 0"
-   ;; TODO: possibly remove this index.  :db.unique/identity should be asserted by the transactor in
-   ;; all cases, but the index may speed up some of SQLite's query planning.  For now, it serves to
-   ;; validate the transactor implementation.  Note that tag is needed here to differentiate, e.g.,
-   ;; keywords and strings.
-   "CREATE UNIQUE INDEX idx_datoms_unique_identity ON datoms (a, value_type_tag, v) WHERE unique_identity IS NOT 0"
-
-   "CREATE TABLE transactions (e INTEGER NOT NULL, a SMALLINT NOT NULL, v BLOB NOT NULL, tx INTEGER NOT NULL, added TINYINT NOT NULL DEFAULT 1, value_type_tag SMALLINT NOT NULL)"
-   "CREATE INDEX idx_transactions_tx ON transactions (tx)"
-
-   ;; Fulltext indexing.
-   ;; A fulltext indexed value v is an integer rowid referencing fulltext_values.
-
-   ;; Optional settings:
-   ;; tokenize="porter"
-   ;; prefix='2,3'
-   ;; By default we use Unicode-aware tokenizing (particularly for case folding), but preserve
-   ;; diacritics.
-   "CREATE VIRTUAL TABLE fulltext_values
-     USING FTS4 (text NOT NULL, tokenize=unicode61 \"remove_diacritics=0\")"
-
-   ;; A view transparently interpolating fulltext indexed values into the datom structure.
-   "CREATE VIEW fulltext_datoms AS
-     SELECT e, a, fulltext_values.text AS v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
-       FROM datoms, fulltext_values
-       WHERE datoms.index_fulltext IS NOT 0 AND datoms.v = fulltext_values.rowid"
-
-   ;; A view transparently interpolating all entities (fulltext and non-fulltext) into the datom structure.
-   "CREATE VIEW all_datoms AS
-     SELECT e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
-       FROM datoms
-       WHERE index_fulltext IS 0
-     UNION ALL
-     SELECT e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value, unique_identity
-       FROM fulltext_datoms"
-
-   ;; Materialized views of the schema.
-   "CREATE TABLE idents (ident TEXT NOT NULL PRIMARY KEY, entid INTEGER UNIQUE NOT NULL)"
-   ;; TODO: allow arbitrary schema values (true/false) and tag the resulting values.
-   "CREATE TABLE schema (ident TEXT NOT NULL, attr TEXT NOT NULL, value TEXT NOT NULL, FOREIGN KEY (ident) REFERENCES idents (ident))"
-   "CREATE INDEX idx_schema_unique ON schema (ident, attr, value)"
-   ])
-
-(defn <create-current-version
-  [db]
-  (->>
-    #(go-pair
-       (doseq [statement v1-statements]
-         (try
-           (<? (s/execute! db [statement]))
-           (catch #?(:clj Throwable :cljs js/Error) e
-             (throw (ex-info "Failed to execute statement" {:statement statement} e)))))
-       (<? (s/set-user-version db current-version))
-       (<? (s/get-user-version db)))
-    (s/in-transaction! db)))
-
-(defn <update-from-version
-  [db from-version]
-  {:pre [(> from-version 0)]} ;; Or we'd create-current-version instead.
-  {:pre [(< from-version current-version)]} ;; Or we wouldn't need to update-from-version.
-  (go-pair
-    (raise-str "No migrations yet defined!")
-    (<? (s/set-user-version db current-version))
-    (<? (s/get-user-version db))))
-
-(defn <ensure-current-version
-  [db]
-  (go-pair
-    (let [v (<? (s/get-user-version db))]
-      (cond
-        (= v current-version)
-        v
-
-        (= v 0)
-        (<? (<create-current-version db))
-
-        (< v current-version)
-        (<? (<update-from-version db v))))))
-
-;; This is close to the SQLite schema since it may impact the value tag bit.
-(defprotocol IEncodeSQLite
-  (->SQLite [x] "Transforms Clojure{Script} values to SQLite."))
-
-(extend-protocol IEncodeSQLite
-  #?@(:clj
-      [String
-       (->SQLite [x] x)
-
-       clojure.lang.Keyword
-       (->SQLite [x] (str x))
-
-       Boolean
-       (->SQLite [x] (if x 1 0))
-
-       Integer
-       (->SQLite [x] x)
-
-       Long
-       (->SQLite [x] x)
-
-       Float
-       (->SQLite [x] x)
-
-       Double
-       (->SQLite [x] x)]
-
-      :cljs
-      [string
-       (->SQLite [x] x)
-
-       Keyword
-       (->SQLite [x] (str x))
-
-       boolean
-       (->SQLite [x] (if x 1 0))
-
-       number
-       (->SQLite [x] x)]))
-
-(defn <-SQLite "Transforms SQLite values to Clojure{Script}."
-  [valueType value]
-  (case valueType
-    :db.type/ref     value
-    :db.type/keyword (keyword (subs value 1))
-    :db.type/string  value
-    :db.type/boolean (not= value 0)
-    :db.type/long    value
-    :db.type/double  value))
-
 (defn ->tag [valueType]
   (or
     (valueType value-type-tag-map)
     (raise "Unknown valueType " valueType ", expected one of " (sorted-set (keys value-type-tag-map))
            {:error :SQLite/tag, :valueType valueType})))
+
+#?(:clj
+(defn <-tagged-SQLite
+  "Transforms SQLite values to Clojure with tag awareness."
+  [tag value]
+  (case tag
+    ;; In approximate commonality order.
+    0  value                               ; ref.
+    1  (= value 1)                         ; boolean
+    4  (java.util.Date. value)             ; instant
+    13 (keyword (subs value 1))            ; keyword
+    12 (java.net.URI. value)               ; URI
+    11 (java.util.UUID/fromString value)   ; UUID
+    ;  5 value                             ; numeric
+    ; 10 value                             ; string
+    value
+    )))
+
+#?(:cljs
+(defn <-tagged-SQLite
+  "Transforms SQLite values to ClojureScript with tag awareness."
+  [tag value]
+  ;; In approximate commonality order.
+  (case tag
+    0  value                               ; ref.
+    1  (= value 1)                         ; boolean
+    4  (new Date value)                    ; instant
+    13 (keyword (subs value 1))            ; keyword
+    ; 12 value                             ; URI
+    ; 11 value                             ; UUID
+    ;  5 value                             ; numeric
+    ; 10 value                             ; string
+    value
+    )))
+
+(defn tagged-SQLite-to-JS
+  "Transforms SQLite values to JavaScript-compatible values."
+  [tag value]
+  (case tag
+    1  (= value 1)     ; boolean.
+    ;  0 value         ; No point trying to ident.
+    ;  4 value         ; JS doesn't have a Date representation.
+    ; 13 value         ; Return the keyword string from the DB: ":foobar".
+    value))


progress on named matrix specs and generators

--- src/polismath/math/named_matrix.clj
+++ src/polismath/math/named_matrix.clj
@@ -159,29 +159,43 @@
     (or matrix [[]])))

+
+(defn named-matrix-gen-of
+  [gen]
+  (gen/bind
+    (gen/tuple
+      (gen/such-that not-empty (gen/vector-distinct (gen/such-that pos? (gen/int))))
+      (gen/such-that not-empty (gen/vector-distinct (gen/such-that pos? (gen/int)))))
+    (fn [[rownames colnames]]
+      (gen/fmap
+        (fn [matrix] (named-matrix rownames colnames matrix))
+        (gen/vector
+          (gen/vector gen (count colnames))
+          (count rownames))))))
+
+;(gen/sample (named-matrix-gen-of (s/gen #{-1 0 1 nil})))
+
+
 (s/def ::NamedMatrix
   (s/with-gen
     (s/and
       (partial satisfies? PNamedMatrix)
       ;(comp get-matrix matrix/matrix?)
-      (comp rownames matrix/vec?)
-      (comp colnames matrix/vec?)
-      (comp rownames distinct)
-      (comp colnames distinct))
+      (comp matrix/vec? rownames)
+      (comp matrix/vec? colnames)
+      (comp distinct rownames)
+      (comp distinct colnames))
     ;; Silly... need way smarter generators here; And maybe actually the generator shouldn't be on this entity, since a named
     ;(clojure.test.check.generators/elements)
-    #(gen/elements #{(named-matrix [1 2 3] [1 2 3] [[0 -1 -1] [0 1 -1] [1 -1 -1]])
-                     (named-matrix [3 1 2] [3 1 2] [[0 nil -1] [0 1 -1] [1 nil 1]])})))
-
-;; Not sure why I'm not able to excercise this?
-;(gen/generator (s/gen ::NamedMatrix))
-;(s/valid?
-;  ::NamedMatrix
-;  (gen/generate
-;    (gen/elements #{(named-matrix [1 2 3] [1 2 3] [[0 -1 -1] [0 1 -1] [1 -1 -1]])
-;                    (named-matrix [3 1 2] [3 1 2] [[0 nil -1] [0 1 -1] [1 nil 1]])})))
-;(gen/generate (s/gen ::NamedMatrix))
-;(s/exercise ::NamedMatrix)
+    #(named-matrix-gen-of (gen/double))))
+
+;(gen/sample (s/gen ::NamedMatrix))
+
+
+;(gen/frequency)
+;(gen/double*)
+;(gen/vector-of)
+;(gen/sample (gen/double* {:min 0 :max 1 :NaN? false :infinite? false}) 100)

 (defmethod print-method NamedMatrix
@@ -193,7 +207,11 @@
       " :matrix " (get-matrix nm)
       "}")))

-
+;(gen/sample (s/gen (s/cat :nm ::NamedMatrix :columns coll?)))
+
+(s/fdef zero-out-columns
+  :args (s/cat :nm ::NamedMatrix :columns coll?)
+  :ret ::NamedMatrix)

 (defn zero-out-columns
   "Creates a new rating matrix which has had the specied columns zeroed out"
@@ -213,6 +231,24 @@
           columns)]
     (named-matrix rows cols m')))

+; Just trying to figure out how the hell function checking really works...
+(require '[clojure.spec.test.alpha :as stest])
+(stest/check `zero-out-columns)
+
+
+(s/fdef whatever
+  :args (s/cat :x (s/and number? #(not= ##NaN %) #(not= 0 %)))
+  :ret number?
+  :fn #(= (-> % :ret (* 2) (-> % :args :x))))
+(defn whatever
+  [x]
+  (/ 2 x))
+
+;(gen/sample (s/gen number?))
+(stest/check `whatever)
+
+
+

 (defn named-matrix-reader
   [{:keys [rownames colnames matrix]}]


Use new reference-usage view

Use new reference-usage view

--- src/discuss/references/main.cljs
+++ src/discuss/references/main.cljs
@@ -70,7 +70,7 @@
     (render [_]
       (dom/div nil
                (bs/center (dom/h5 nil "Neues Argument mit dieser Referenz erzeugen"))
-               (rlib/current-reference-component)
+               (om/build rlib/current-reference-component {})
                (om/build find/form-view {})
                (om/build find/results-view data)))))

@@ -93,7 +93,7 @@
   (reify om/IRender
     (render [_]
       (bs/center
-        (rlib/current-reference-component)
+        (om/build rlib/current-reference-component {})
         (bs/button-primary #(query-reference-details (:id (rlib/get-selected-reference)))
                            "Wo wird diese Referenz verwendet?")
         " "
@@ -141,7 +141,7 @@
       (let [usages (rlib/get-reference-usages)]
         (dom/div nil
                  (dom/h5 nil "Wo wird diese Referenz verwendet?")
-                 (rlib/current-reference-component)
+                 (om/build rlib/current-reference-component {})
                  (apply dom/div nil
                         (map #(om/build usage-list-view (lib/merge-react-key %)) usages)))))))


Add checking so that non-combat npcs cannot be attacked

--- src/dungeon_crusade/update.clj
+++ src/dungeon_crusade/update.clj
@@ -97,7 +97,8 @@
                                     (assoc-in [:pos :x] player-x)
                                     (assoc-in [:pos :y] player-y))
                                 npc))))
-      (npc-at-xy state target-x target-y)
+      (and (npc-at-xy state target-x target-y)
+           (every? (npc-at-xy state target-x target-y) [:hp :race :inventory]))
         ;; collided with npc. Engage in combat.
         (attack state [:world :player] (npc->keys state (npc-at-xy state target-x target-y)))
       ;; collided with a wall or door, nothing to be done.


Sleep amount could be real number

Sleep amount could be real number

--- src/emender_jenkins/config.clj
+++ src/emender_jenkins/config.clj
@@ -32,7 +32,7 @@
         (update-in [:config :pretty-print]               utils/parse-boolean)
         (update-in [:config :include-jenkins-reply]      utils/parse-boolean)
         (update-in [:config :verbose-show-configuration] utils/parse-boolean)
-        (update-in [:fetcher :job-fetcher-delay]         utils/parse-int)
+        (update-in [:fetcher :job-fetcher-delay]         utils/parse-float)
         (update-in [:fetcher :run-job-fetcher]           utils/parse-boolean)
         (update-in [:irc :port]                          utils/parse-int)
         (update-in [:irc :connect]                       utils/parse-boolean)))


more useful exception info on callback fail

--- src/er_cassandra/model/types.clj
+++ src/er_cassandra/model/types.clj
@@ -227,10 +227,16 @@
   ([^Model model callback-key records opts]
    (let [callbacks (concat (get-in model [:callbacks callback-key])
                            (get-in opts [callback-key]))]
-     (reduce (fn [r callback]
-               (mapv callback r))
-             records
-             callbacks))))
+     (try
+       (reduce (fn [r callback]
+                 (mapv callback r))
+               records
+               callbacks)
+       (catch Exception ex
+         (throw (ex-info "Failed to run callbacks on record"
+                         {:callback-key callback-key
+                          :model model}
+                         ex)))))))

 (defn run-callbacks-single
   ([^Model model callback-key record]


Wrap application of job function in io!.

--- src/fhofherr/simple/engine.clj
+++ src/fhofherr/simple/engine.clj
@@ -242,7 +242,7 @@

 (defn execute-job!
   [job-desc exec-id]
-  (letfn [(apply-job-fn [job-fn exec] (job-fn (:context exec)))]
+  (letfn [(apply-job-fn [job-fn exec] (io! (job-fn (:context exec))))]
     (update-job-execution! job-desc exec-id mark-executing)
     (try
       (let [exec (get-job-execution job-desc exec-id)


add additional logging for nouns exceptions

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -738,9 +738,12 @@
         (string? (get-in word '(:english :english)))
         (not (= (get-in word [:pronoun]) true))
         (not (= (get-in word [:propernoun]) true)))
-   (str (plural-en (get-in word '(:english :english) word))
-        (if (get-in word '(:english :note))
-          (str (get-in word '(:english :note)))))
+   (do
+     (log/debug (str "using exceptional form:"
+                     word))
+     (str (plural-en (get-in word '(:english :english) word))
+          (if (get-in word '(:english :note))
+            (str (get-in word '(:english :note))))))

    (and (= (get-in word '(:cat)) :adjective)
         (string? (get-in word '(:english))))


don't show gender symbol if :gendered = true

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -141,13 +141,20 @@
    (and (string? (get-in word [:english]))
         (= :masc (get-in word [:gender]))
         (= true (get-in word [:pronoun]))
-        (= "it" from-language))
+        (= "it" from-language)
+        ;; If a pronoun is 'gendered', it means that the gender
+        ;; is implicit in the word, e.g. "he" and "she".
+        ;; An example of a non-gendered pronoun in English is "they",
+        ;; or "loro" in Italian, but in contrast, in French, "ils"
+        ;; and "elles" *are* gendered.
+        (= false (get-in word [:agr :gendered] false)))
    (trim (str (get-in word [:english]) " (♂)"))

    (and (string? (get-in word [:english]))
         (= :fem (get-in word [:gender]))
         (= true (get-in word [:pronoun]))
-        (= "it" from-language))
+        (= "it" from-language)
+        (= false (get-in word [:agr :gendered] false)))
    (trim (str (get-in word [:english]) " (♀)"))

    ;; :note is used for little annotations that are significant in italian but not in english


Import URLDecoder

Import URLDecoder

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -35,14 +35,17 @@
   correct argument resolution strategy at dispatch table compilation
   time."
   {:added "0.1.10"}
-  (:require [clojure.core.async :as async]
-            [clojure.string :as string]
-            [clojure.set :as set]
-            [io.aviso.tracker :as t]
-            [io.aviso.rook.internals :as internals :refer [consume]]
-            [clojure.string :as str]
-            [clojure.tools.logging :as l]
-            [io.aviso.rook.utils :as utils]))
+  (:import
+    [java.net URLDecoder])
+  (:require
+    [clojure.core.async :as async]
+    [clojure.string :as string]
+    [clojure.set :as set]
+    [io.aviso.tracker :as t]
+    [io.aviso.rook.internals :as internals :refer [consume]]
+    [clojure.string :as str]
+    [clojure.tools.logging :as l]
+    [io.aviso.rook.utils :as utils]))

 (def ^:private default-mappings

@@ -88,7 +91,7 @@
   assumed."
   [request]
   [(:request-method request)
-   (mapv #(java.net.URLDecoder/decode ^String % "UTF-8")
+   (mapv #(URLDecoder/decode ^String % "UTF-8")
          (next (string/split (:uri request) #"/" 0)))])

 (defn path-spec->route-spec


Compression

Compression


messing with analog bubbles

messing with analog bubbles

--- src/examples/sc2_examples.clj
+++ src/examples/sc2_examples.clj
@@ -3,19 +3,36 @@

 (refer-ugens)

-; analog bubbles
+; Here are a few ways to define the same example from SC2, analog bubbles.
+; They all produce an identical synthdef, so it's a matter of style I guess.
 (defsynth analog-bubbles []
-  (let [freqs (midicps (mul-add (lf-saw:kr 0.4 0)
-                                24
-                                (mul-add (lf-saw:kr [8 7.23] 0)
-                                3 80)))]
+  (let [freqs (midicps (mul-add (lf-saw:kr 0.4 0) 24
+                                (mul-add (lf-saw:kr [8 7.23] 0) 3 80)))]
     (comb-n (* (sin-osc freqs 0) 0.04) 0.2 0.2 4)))

+(defsynth analog-bubbles []
+  (let [o (-> (lf-saw:kr [8 7.23]) (* 3) (+ 80))
+        f (-> (lf-saw:kr 0.4) (* 24) (+ o))
+        s (-> (sin-osc (midicps f)) (* 0.3))]
+    (comb-n s 0.2 0.2 4)))
+
+(defsynth analog-bubbles []
+  (let [o (mul-add (lf-saw:kr [8 7.23]) 3 80)
+        f (mul-add (lf-saw:kr 0.4) 24 o)
+        s (mul-add (sin-osc (midicps f)) 0.3 0)]
+    (comb-n s 0.2 0.2 4)))
+
+(defsynth analog-bubbles []
+  (let [o (+ 80 (* 3 (lf-saw:kr [8 7.23])))
+        f (+ o  (* 24 (lf-saw:kr 0.4)))
+        s (* 0.3 (sin-osc (midicps f)))]
+    (comb-n s 0.2 0.2 4)))
+
 (defsynth resonant-pulses [busnum 0]
-  (out busnum
-       (comb-l
+  (out busnum
+       (comb-l
          (rlpf (* 0.05 (lf-pulse (mul-add (f-sin-osc:kr 0.05 0) 80 160) 0 0.4))
-               (mul-add (f-sin-osc:kr [0.6 0.7] 0) 3600 4000)
+               (mul-add (f-sin-osc:kr [0.6 0.7] 0) 3600 4000)
                0.2)
          0.3 [0.2 0.25] 2)))


remove unused table.core

remove unused table.core

--- src/gh_waiting_room/github.clj
+++ src/gh_waiting_room/github.clj
@@ -1,7 +1,6 @@
 (ns gh-waiting-room.github
   (:require [tentacles.issues :refer [my-issues create-comment]]
             [tentacles.repos :refer [create-hook hooks repos delete-hook]]
-            table.core
             [gh-waiting-room.config :refer [gh-auth issue-url-regex gh-hide-labels
                                             app-domain gh-user hook-forks]]))


Replace deprecated core/execute-step function with the current alternative

--- test/lambdacd_value_stream/core_test.clj
+++ test/lambdacd_value_stream/core_test.clj
@@ -3,9 +3,9 @@
             [lambdacd-value-stream.core :as core]
             [lambdacd.state.internal.pipeline-state-updater :as pipeline-state]
             [clojure.core.async :as async]
-            [lambdacd.core :as lambdacd-core]
             [lambdacd-value-stream.test_utils :refer [some-ctx-with read-channel-or-time-out slurp-chan-with-size map-containing create-temp-dir]]
-            [lambdacd.event-bus :as event-bus]))
+            [lambdacd.event-bus :as event-bus]
+            [lambdacd.execution.core :as execution-core]))

 ; SYNTACTIC SUGAR FIRST. SCROLL DOWN FOR TESTS

@@ -41,8 +41,8 @@

 (defn start-wait-for-pipeline-success [state & {:keys [pipeline-to-wait-for] :or {pipeline-to-wait-for :some-pipeline}}]
   (let [wait-for-result-channel (async/go
-                                  (let [execute-step-result (lambdacd-core/execute-step {} (:ctx @state)
-                                                                                (fn [args ctx]
+                                  (let [execute-step-result (execution-core/execute-step {} (:ctx @state)
+                                                                                (fn [args ctx]
                                                                                (core/wait-for-pipline-success pipeline-to-wait-for ctx)))]
                                     (first (vals (:outputs execute-step-result)))))]
     (swap! state #(assoc % :result-channel wait-for-result-channel))
@@ -51,8 +51,8 @@

 (defn start-wait-for-upstream-trigger [state]
   (let [wait-for-result-channel (async/go
-                                  (let [execute-step-result (lambdacd-core/execute-step {} (:ctx @state)
-                                                                                (fn [args ctx]
+                                  (let [execute-step-result (execution-core/execute-step {} (:ctx @state)
+                                                                                (fn [args ctx]
                                                                                (core/wait-for-upstream-trigger args ctx)))]
                                     (first (vals (:outputs execute-step-result)))))]
     (swap! state #(assoc % :result-channel wait-for-result-channel))


Added more inclusive fallback options.

Added more inclusive fallback options.

--- src/blutwurst/tuple_generator.clj
+++ src/blutwurst/tuple_generator.clj
@@ -31,12 +31,12 @@
   [
    {
       :name "Random String Generator"
-      :determiner #(= (:type %) "VARCHAR")
+      :determiner #(some #{(:type %)} '("VARCHAR" "NVARCHAR" "CHAR"))
       :generator #(random-string (or (min (:length %) 2000) 255))
    }
    {
        :name "Random Integer Generator"
-       :determiner #(= (:type %) "INTEGER")
+       :determiner #(some #{(:type %)} '("INTEGER" "SMALLINT"))
        :generator (fn [c] (random-integer)) ; TODO account for column's max value
    }
    {


Redirect when bad group-id

Redirect when bad group-id

--- src/braid/client/core/events.cljs
+++ src/braid/client/core/events.cljs
@@ -508,10 +508,12 @@
                               (dispatch [:set-login-state :login-form])
                               (dispatch [:clear-session]))}}))

-(reg-event-db
+(reg-event-fx
   :set-group-and-page
-  (fn [state [_ [group-id page-id]]]
-    (assoc state :open-group-id group-id :page page-id)))
+  (fn [{state :db :as cofx} [_ [group-id page-id]]]
+    (if (or (nil? group-id) (some? (get-in state [:groups group-id])))
+      {:db (assoc state :open-group-id group-id :page page-id)}
+      {:dispatch [:redirect-to-first-group]})))

 (reg-event-fx
   :redirect-to-first-group


Rendering tree with chapter and groups

Rendering tree with chapter and groups

--- src/hurvinek/html_renderer.clj
+++ src/hurvinek/html_renderer.clj
@@ -242,7 +242,7 @@

 (defn render-chapter-list
     "Render chapter list for selected product."
-    [url-prefix title product-id product-name chapter-list & [message-type message]]
+    [url-prefix title product-id product-name chapter-list groups-per-chapter & [message-type message]]
     (page/xhtml
         (render-html-header url-prefix title)
         [:body
@@ -251,13 +251,16 @@
                 (render-breadcrumb url-prefix "select-product" (str "Product: " product-name))
                 (render-optional-message message-type message)
                 [:div {:class "container-fluid"}
-                    [:h2 (str "Chapters for product " product-name)]
+                    [:h2 (str "Chapters and groups for product " product-name)]
                     [:table {:style "border-collapse: separate; border-spacing: 10px;"}
                         (for [chapter chapter-list]
                             [:tr
-                                [:td (:name chapter)]
-                                [:td [:a {:href (str "edit-chapter?product-id=" product-id "&chapter-id=" (:id chapter) )} "rename"]]
-                                [:td [:a {:href (str "chapter?product-id=" product-id "&chapter-id=" (:id chapter))} "group list"]]])
+                                [:td [:h4 (:name chapter)]
+                                    (for [group (get groups-per-chapter (:id chapter))]
+                                        (str "   " (:name group) "
"))
+                                ]
+                                [:td {:style "vertical-align:top"} [:h4 [:a {:href (str "edit-chapter?product-id=" product-id "&chapter-id=" (:id chapter) )} "rename"]]]
+                                [:td {:style "vertical-align:top"} [:h4 [:a {:href (str "chapter?product-id=" product-id "&chapter-id=" (:id chapter))} "group list"]]]])
                     ]]
                     [:br]
                     [:h3 "New chapter"]


migrate to midje for core.models.status (#190)

* the stub

* add test for format-sts

* fix spelling

--- test/yetibot/core/test/models/status.clj
+++ test/yetibot/core/test/models/status.clj
@@ -1,23 +1,22 @@
 (ns yetibot.core.test.models.status
-  (:require
-    [clojure.test :refer :all]
-    [yetibot.core.models.status :refer :all]
-    [clj-time
-     [format :refer [formatter unparse]]
-     [core :refer [day year month
-                   to-time-zone after?
-                   default-time-zone now time-zone-for-id date-time utc
-                   ago days weeks years months]]]))
+  (:require [yetibot.core.models.status :as sts]
+            [yetibot.core.models.users :refer [get-user]]
+            [clj-time
+             [core :refer [ago hours]]
+             [coerce :refer [to-sql-time]]]
+            [midje.sweet :refer [=> fact facts provided anything
+                                 every-checker contains]]))

-;; helpers
-
-(defn- n-days-ago [n] (-> n days ago))
-
-(defn- status-map-for-n-days-ago [n]
-  {:timestamp (n-days-ago n)
-   :status (str "days ago: " n)})
-
-(defn- flat-status-map-n-days-ago [n]
-  ((juxt :timestamp :status) (status-map-for-n-days-ago n)))
-
-(defn- u [id] {:name (str id) :id id}) ;; user stub
+(facts
+ "about models.status"
+ (fact
+  "it creates a coll of strings that contain '<username> <timestamp> <status>' info"
+  (let [name "zero"
+        status "hello world"
+        sts {:user-id "0"
+             :status status
+             :created-at (to-sql-time (-> 8 hours ago))}]
+    (first (sts/format-sts [sts])) => (every-checker
+                                       (contains status)
+                                       (contains name))
+    (provided (get-user anything (:user-id sts)) => {:name name}))))


annotated the whoopbang function

annotated the whoopbang function

--- src/clj/forma/trends/analysis.clj
+++ src/clj/forma/trends/analysis.clj
@@ -3,21 +3,27 @@
         [forma.trends.filter :only (deseasonalize)])
   (:require [incanter.core :as i]))

-; WHOOPBANG
-
-(defn whoop-cofactor
+;; The following is a set of functions, under the header WHOOPBANG,
+;; which collects the greatest short-term drop in a preconditioned and
+;; filtered time-series of a vegetation index.  Currently, the final
+;; function requires three values: (1) time-series as a vector or
+;; sequence (2) a scalar parameter indicating the length of the block
+;; to which the ordinary least squares regression in applied, which
+;; was 15 in the original FORMA specification (3) the length of the
+;; window that smooths the OLS coefficients, which was originally 5.
+
+(defn time-trend-cofactor
   "construct a matrix of cofactors; first column is comprised of ones,
   second column is a range from 1 to [num-months].  The result is a
   [num-months]x2 incanter matrix."
   [num-months]
   (i/trans (i/bind-rows (repeat num-months 1) (range 1 (inc num-months)))))

-(defn whoop-ols
-  "extract OLS coefficient from a time-series as efficiently
-  as possible for the whoopbang function."
+(defn ols-coefficient
+  "extract OLS coefficient from a time-series."
   [ts]
   (let [ycol (i/trans [ts])
-        X (whoop-cofactor (count ts))
+        X (time-trend-cofactor (count ts))
         V (variance-matrix X)]
   (i/sel (i/mmult V (i/trans X) ycol) 1 0)))

@@ -29,10 +35,10 @@
 (defn whoopbang
   "whoopbang will find the greatest OLS drop over a timeseries [ts] given
   sub-timeseries of length [long-block].  The drops are smoothed by a moving
-  average window of length [mov-avg]."
+  average window of length [window]."
   [ts long-block window]
   (->> (deseasonalize ts)
-       (windowed-apply whoop-ols long-block)
+       (windowed-apply ols-coefficient long-block)
        (windowed-apply average window)
        (reduce min)))


Add cell color for player

Add cell color for player

--- src/cljs/battle_console/game.cljs
+++ src/cljs/battle_console/game.cljs
@@ -72,12 +72,21 @@
                   (dom/td nil unit)
                   (dom/td nil quantity))))))))))

+(defn- get-element-css
+  "Gets a CSS class for the given element"
+  [element]
+  (condp = (get element "player")
+    "p1" "success"
+    "p2" "warning"
+    nil ""))
+
 (defn- render-board-cell
   "Renders a board's cell"
   [game x y]
   (let [coordCode (str "[" x " " y "]")
-        element (get-in game ["battle" "elements" coordCode])]
-    (dom/div nil
+        element (get-in game ["battle" "elements" coordCode])
+        css (get-element-css element)]
+    (dom/td #js {:className css}
       (dom/p #js {:className "boardCoords"} coordCode)
       (dom/p #js {:className "boardUnit"} (or (get element "unit") "-"))
       (dom/p #js {:className "boardQuantity"} (or (get element "quantity") 0)))))
@@ -91,7 +100,7 @@
         (for [y (range 1 9)]
           (apply dom/tr #js {:className "active"}
             (for [x (range 1 9)]
-              (dom/td nil (render-board-cell game x y)))))))))
+              (render-board-cell game x y))))))))

 (defn- get-name-for
   "Gets the name to be on the given position"


Handle empty queries on feedback page

Handle empty queries on feedback page

--- src/cljs/clojuredocs/widgets.cljs
+++ src/cljs/clojuredocs/widgets.cljs
@@ -495,7 +495,7 @@
     (will-mount [_]
       (let [query (om/get-state owner :query)]
         (om/set-state! owner
-          :text (when query
+          :text (when-not (empty? query)
                   (str
                     "Hey ClojureDocs, I searched for \""
                     query


Event page

Event page

--- src/cljs/elevent_client/core.cljs
+++ src/cljs/elevent_client/core.cljs
@@ -722,6 +722,123 @@
                                         :on-click #(create-event @form)}
              "Add"]]]]]))))

+(defn event-page [event-id]
+  (let [event (d/entity @events-db event-id)
+
+        activities (map #(d/entity @activities-db %)
+                        (d/q '[:find [?e ...]
+                               :in $ ?event-id
+                               :where
+                               [?e :EventId ?event-id]]
+                             @activities-db
+                             event-id))
+        attendees (take 10
+                        (map (fn [[user-id attendee-id]]
+                               (merge
+                                 (into
+                                   {}
+                                   (d/entity
+                                     @users-db
+                                     user-id))
+                                 (into
+                                   {}
+                                   (d/entity
+                                     @attendees-db
+                                     attendee-id))))
+                             (d/q '[:find ?e ?a
+                                    :in $ ?event-id
+                                    :where
+                                    [?a :EventId ?event-id]
+                                    [?a :UserId ?e]]
+                                  @attendees-db
+                                  event-id)))]
+    (when (seq event)
+      [:div.ui.page.grid
+       [:div.sixteen.wide.column
+        [:div.ui.segment
+         [:div.ui.vertical.segment
+          [:h2.ui.dividing.header
+           (:Name event)]
+          [:div.ui.right.floated.small.labeled.icon.button
+           [:i.edit.icon]
+           "Edit"]
+          [:div
+           [:b "Date: "]
+           (when (and (:StartDate event)
+                      (:EndDate event))
+             (let [start (from-string (:StartDate event))
+                   end   (from-string (:EndDate   event))]
+               (str (unparse datetime-formatter start)
+                    (when (after? end start)
+                      (str " to "
+                           (unparse datetime-formatter end))))))]
+          [:div
+           [:b "Venue: "] (:Venue event)]
+          [:p (:Description event)]]
+         [:div.ui.vertical.segment
+          [:h2.ui.header
+           "Activities"
+           [:a.ui.right.floated.small.button
+            {:href (event-activity-add-route event)}
+            "View/Edit"]]
+          [:table.ui.table
+           [:thead
+            [:tr
+             [:th "Start"]
+             [:th "End"]
+             [:th "Activity"]
+             [:th "Location"]]]
+           [:tbody
+            (for [activity activities]
+                ^{:key (:ActivityId activity)}
+                [:tr
+                 [:td {:noWrap true}
+                  (when activity
+                    (unparse datetime-formatter
+                             (from-string (:StartTime activity))))]
+                 [:td {:noWrap true}
+                  (when activity
+                    (unparse datetime-formatter
+                             (from-string (:EndTime activity))))]
+                 [:td (:Name activity)]
+                 [:td (:Location activity)]])]
+           [:tfoot
+            [:tr
+             [:th {:colSpan "4"}
+              [:a.ui.right.floated.small.labeled.icon.button
+               {:href (event-activity-add-route event)}
+               [:i.edit.icon]
+               "Edit"]]]]]]
+         [:div.ui.vertical.segment
+          [:h2.ui.header
+           "Attendees"
+           [:a.ui.right.floated.small.button
+            {:href (event-attendees-route event)}
+            "View"]]
+          [:table.ui.table
+           [:thead
+            [:tr
+             [:th "Name"]
+             [:th]]]
+           [:tbody
+            (for [attendee attendees]
+              ^{:key (:AttendeeId attendee)}
+              [:tr
+               [:td (str (:FirstName attendee) " " (:LastName attendee))]
+               [:td [:a.ui.right.floated.small.labeled.button
+                     {:href (event-attendee-route {:EventId (:EventId event)
+                                                   :AttendeeId (:AttendeeId attendee)})
+                      :class (when (:CheckinTime attendee) :green)}
+                     (if (:CheckinTime attendee)
+                       "Checked in"
+                       "Check in")]]])]
+           [:tfoot
+            [:tr
+             [:th {:colSpan "4"}
+              [:div.ui.right.floated.small.labeled.icon.button
+               [:i.edit.icon]
+               "Edit"]]]]]]]]])))
+
 (defn event-register-page [event-id]
   (let [form (atom {:Email (get-in @session [:user :Email])
                     :FirstName (get-in @session [:user :FirstName])


Adapt benchmark code to new async implementation.

--- src/clojure/nanomsg/benchmark.clj
+++ src/clojure/nanomsg/benchmark.clj
@@ -1,10 +1,12 @@
 (ns nanomsg.benchmark
-  (:require [nanomsg :as nn])
+  (:require [nanomsg :as nn]
+            [clojure.core.async :as async])
   (:gen-class))

 (defn- thread
   [func]
   (let [th (Thread. func)]
+    (.setDaemon th false)
     (.start th)))

 (defn- sleep
@@ -12,8 +14,7 @@
   (Thread/sleep t))

-(defn -main
-  []
+(defn bench-fn1 []
   (let [sended    (atom 0)
         received  (atom 0)
         pubsock   (nn/socket :pub)]
@@ -46,3 +47,39 @@
       (doseq [x (range 1000000000000)]
         (nn/send! pubsock "test foobar")
         (swap! sended inc)))))
+
+
+(defn bench-async []
+  (let [sended    (atom 0)
+        received  (atom 0)
+        s1        (nn/socket :pub {:bind "ipc:///tmp/bench.async" :async true})
+        s2        (nn/socket :sub {:connect "ipc:///tmp/bench.async" :async true})]
+    (nn/subscribe! s2 "Hello")
+    (thread (fn []
+              (loop [initial-sended    @sended
+                     initial-received  @received]
+                (sleep 1000)
+                (println (format "Sended: %s/s Received %s/s"
+                                 (- @sended initial-sended)
+                                 (- @received initial-received)))
+                (recur @sended @received))))
+    (async/go
+      (loop []
+        (async/<! (nn/send! s1 "Hello World"))
+        (swap! sended inc)
+        (recur)))
+    (async/go
+      (loop []
+        (async/<! (nn/send! s1 "Hello World"))
+        (swap! sended inc)
+        (recur)))
+    (async/go
+      (loop []
+        (let [recd (async/<! (nn/recv! s2))]
+          (swap! received inc)
+          (recur))))))
+
+
+(defn -main
+  []
+  (bench-async))


Output path on trace tree

Output path on trace tree

--- src/com/wsscode/pathom/trace.cljc
+++ src/com/wsscode/pathom/trace.cljc
@@ -98,6 +98,7 @@
               (if (contains? (:visited x) next-path)
                 x
                 (-> x
+                    (assoc-in [:response :com.wsscode.pathom.core/path] path)
                     (assoc-in [:response ::children key]
                       (-> (merge (trace->tree* paths next-path) (select-keys row [::relative-timestamp :key]))
                           (assoc :com.wsscode.pathom.core/path next-path)))
@@ -168,9 +169,11 @@
         (compute-details-duration)))
     trace-tree))

-(defn compute-d3-tree [{::keys [relative-timestamp duration children details]
-                        :keys  [key]}]
+(defn compute-d3-tree [{::keys                        [relative-timestamp duration children details]
+                        :com.wsscode.pathom.core/keys [path]
+                        :keys                         [key]}]
   (cond-> {:start    relative-timestamp
+           :path     path
            :duration (or duration 0)
            :details  (mapv (fn [{::keys [relative-timestamp duration event]
                                  :as    row}]


Cleanup and format word map

Cleanup and format word map

--- src/instantetymonline/core.clj
+++ src/instantetymonline/core.clj
@@ -1,10 +1,7 @@
 (ns instantetymonline.core
   (:require [net.cgrand.enlive-html :as html]))

-(def ^:dynamic *base-url* "http://etymonline.com/index.php?l=e&p=9")
-
-;; this is letter e and page 10. There are ~1000 pages in total.
-;;(def http://etymonline.com/index.php?l=e&p=9
+;; There are ~1000 pages in total.

 ;; Basic algorithm:
 ;; For each letter
@@ -21,28 +18,46 @@

 ;; Want something like this but way more fuzzy
 ;; (get etyms "elitism (n.)")
+;; For now, let's just split by space (misses some like "Ellis Island")
+
+;; Persistence
+
+
+
+(defn gen-url [letter page]
+  (str "http://etymonline.com/index.php?l=" letter "&p=" page))

 (defn fetch-url [url]
   (html/html-resource (java.net.URL. url)))

-(defn etym-words []
-  (map html/text (html/select (fetch-url *base-url*) [:dt :a])))
+;; TODO: Add back verb/noun info.
+;; TODO: Keep "Ellis Island" (right now it's turned into "Ellis").
+(defn etym-words [hnodes]
+  (let [raw (map html/text (html/select hnodes [:dt :a]))
+        text (remove empty? raw)]
+    (map #(first (clojure.string/split % #" "))
+         text)))

-(defn etym-links []
-  (map html/text (html/select (fetch-url *base-url*) [:dd.highlight :a])))
+;; TODO: Use links with cross-references from here.
+(defn etym-links [hnodes]
+  (map html/text (html/select hnodes [:dd.highlight :a])))

-(defn etym-descriptions []
-  (map html/text (html/select (fetch-url *base-url*) [:dd])))
+(defn etym-descriptions [hnodes]
+  (map html/text (html/select hnodes [:dd])))

-#_(def words (remove empty? (etym-words)))
-;; Elihu,  -, Elijah, "", eliminate [these are all the titles]
+(defn etyms [hnodes]
+  (zipmap (etym-words hnodes)
+          (etym-descriptions hnodes)))

-#_(def links (etym-links))
-;; trickiest to match up, but can do with "see X" and cross ref, I think.
-;; don't think about this one for now
-;; ex- limit Elijah [all the linked words in description, I think]
+;; NOTE: Temporary - fetch hnodes once though
+#_(def e9 (fetch-url "e" "9")) ;; e9 is a seq of hnodes

-#_(def descriptions (etym-descriptions))
-;; masc. proper name, name of grat Old TE.. [all the descriptions]
+(def e9-map (etyms e9))

-(def etyms (zipmap words descriptions))
+;; Persistence
+;; (spit "data/e9" e9-map)
+;; (def e9a (read-string (slurp "data/e9")))
+
+;; To look up a word:
+;; (get e9a "else") ;; => description string
+;; (get e9a "nosuchword") ;; => nil


Found race condition in make-generator

Found race condition in make-generator

which needs to be fixed.

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

--- src/conexp/contrib/generators.clj
+++ src/conexp/contrib/generators.clj
@@ -47,7 +47,7 @@
 			    (apply ~function args#)
 			    (swap! end# (constantly true)))))
 	 (fn []
-	   (if @end#
+	   (if @end# ; -> race condition! (if we are faster than our thread we may halt here)
 	     (throw
 	      (java.util.NoSuchElementException. "No more elements to generate."))
 	     (.take queue#)))))))


Make function as private

Make function as private

--- src/io/aviso/twixt/fs_cache.clj
+++ src/io/aviso/twixt/fs_cache.clj
@@ -16,7 +16,7 @@
          (checksum streamable)
          (.substring name dotx))))

-(defn ^File find-cache-file
+(defn- ^File find-cache-file
   [cache-dir streamable]
   "Checks the file system cache for previously generated content for the streamable. Returns the File
   for the cached content, which may or may not exist."


Project name parameters now read from project.clj.

--- src/leiningen/appengine_new.clj
+++ src/leiningen/appengine_new.clj
@@ -29,8 +29,17 @@
 (defn appengine-new [project]
   (let [resources-dir (File. (:resources-path project))
         war-dir (File. resources-dir "war")
-        WEB-INF-dir (File. war-dir "WEB-INF")]
+        WEB-INF-dir (File. war-dir "WEB-INF")
+        prj-application (:appengine-application project)
+        prj-display-name (:appengine-display-name project)]
     (println "making new App Engine project")
+    ;; verify required entries
+    (when-not prj-application
+      (println ":appengine-application required in project.clj")
+      (System/exit 1))
+    (when-not prj-display-name
+      (println ":appengine-display-name required in project.clj")
+      (System/exit 1))
     ;; set up the required paths
     (when-not (.exists resources-dir)
       (.mkdir resources-dir)
@@ -50,12 +59,13 @@
           out-appengine-web-xml (File. WEB-INF-dir "appengine-web.xml")]
       (if (.exists out-web-xml)
           (println out-web-xml "already exists, not overwriting")
-          (do (xpath-replace-all in-web-xml out-web-xml "//display-name" "Coronado Bay")
+          (do (xpath-replace-all in-web-xml out-web-xml "//display-name" prj-display-name)
               (println "web.xml written to" (.getPath out-web-xml))))
       (if (.exists out-appengine-web-xml)
           (println out-appengine-web-xml "already exists, not overwriting")
           (do (xpath-replace-all in-appengine-web-xml out-appengine-web-xml
-                                 "//application" "coronado-bay")
+                                 "//application" prj-application)
               (println "appengine-web.xml written to" (.getPath out-appengine-web-xml)))))
     ;; done
-    (println "App Engine project" "Coronado Bay" "created; you should add it to source control")))
+    (println "App Engine project" prj-display-name
+             "created; you should add it to source control")))


More on atoms.

More on atoms.

--- test/com/nomistech/clojure_the_language/intro_to_state.clj
+++ test/com/nomistech/clojure_the_language/intro_to_state.clj
@@ -21,44 +21,44 @@
 ;;;; ___________________________________________________________________________
 ;;;; Atoms: `atom`, `deref`, `@` and `swap!`

-(def my-atom-1 (atom 0))
+(def my-number-atom (atom 0))

-(fact (deref my-atom-1) => 0)
-(fact @my-atom-1 => 0)
+(fact (deref my-number-atom) => 0)
+(fact @my-number-atom => 0)

-(swap! my-atom-1 inc) ; (inc 0)
-(fact @my-atom-1 => 1)
+(swap! my-number-atom inc) ; (inc 0)
+(fact @my-number-atom => 1)

-(swap! my-atom-1 inc) ; (inc 1)
-(fact @my-atom-1 => 2)
+(swap! my-number-atom inc) ; (inc 1)
+(fact @my-number-atom => 2)

 ;;;; Supplying args to the swap function:

-(swap! my-atom-1 + 1) ; (+ 2 1)
-(fact @my-atom-1 => 3)
+(swap! my-number-atom + 1) ; (+ 2 1)
+(fact @my-number-atom => 3)

-(swap! my-atom-1 + 1) ; (+ 3 1)
-(fact @my-atom-1 => 4)
+(swap! my-number-atom + 1) ; (+ 3 1)
+(fact @my-number-atom => 4)

-(swap! my-atom-1 + 10 20 30) ; (+ 4 10 20 30)
-(fact @my-atom-1 => 64)
+(swap! my-number-atom + 10 20 30) ; (+ 4 10 20 30)
+(fact @my-number-atom => 64)

 ;; Maps in atoms

-(def my-atom-2 (atom {}))
+(def my-map-atom (atom {}))

-(swap! my-atom-2 assoc :first-name "Alice")
-(fact @my-atom-2 => {:first-name "Alice"})
+(swap! my-map-atom assoc :first-name "Alice")
+(fact @my-map-atom => {:first-name "Alice"})

-(swap! my-atom-2 assoc :first-name "Bob")
-(fact @my-atom-2 => {:first-name "Bob"})
+(swap! my-map-atom assoc :first-name "Bob")
+(fact @my-map-atom => {:first-name "Bob"})

-(swap! my-atom-2 assoc-in [:address :line-1] "78 Green Lane")
-(swap! my-atom-2 assoc-in [:address :line-2] "New Town")
-(fact @my-atom-2 => {:first-name "Bob"
-                     :address {:line-1 "78 Green Lane"
-                               :line-2 "New Town"}})
+(swap! my-map-atom assoc-in [:address :line-1] "78 Green Lane")
+(swap! my-map-atom assoc-in [:address :line-2] "New Town")
+(fact @my-map-atom => {:first-name "Bob"
+                       :address {:line-1 "78 Green Lane"
+                                 :line-2 "New Town"}})

 ;;;; ___________________________________________________________________________
@@ -68,8 +68,8 @@
 ;;;; ___________________________________________________________________________
 ;;;; `reset!`

-(reset! my-atom-1 100)
-(fact @my-atom-1 => 100)
+(reset! my-number-atom 100)
+(fact @my-number-atom => 100)

 ;;;; ___________________________________________________________________________
 ;;;; Atoms and concurrency


Delete ‘test-conexp’ function

Delete ‘test-conexp’ function

--- src/main/clojure/conexp/base.clj
+++ src/main/clojure/conexp/base.clj
@@ -98,36 +98,6 @@
 ;;; Testing

 (require 'clojure.test)
-
-(defn test-conexp
-  "Runs tests for conexp-clj."
-  ([]
-   (let [nss '[conexp.tests.base
-               conexp.tests.math.optimize
-               conexp.tests.math.statistics
-               conexp.tests.fca.contexts
-               conexp.tests.fca.exploration
-               conexp.tests.fca.implications
-               conexp.tests.fca.lattices
-               conexp.tests.fca.many-valued-contexts
-               conexp.tests.fca.more
-               conexp.tests.io.contexts
-               conexp.tests.io.lattices
-               conexp.tests.io.layouts
-               conexp.tests.io.many-valued-contexts
-               conexp.tests.io.util
-               conexp.tests.layouts.base
-               conexp.tests.layouts.common
-               conexp.tests.layouts.force
-               conexp.tests.layouts.freese
-               conexp.tests.layouts.layered
-               conexp.tests.layouts.util
-               conexp.contrib.tests.algorithms
-               conexp.contrib.tests.algorithms.concepts
-               conexp.contrib.tests.algorithms.generators
-               conexp.contrib.tests.algorithms.titanic]]
-     (apply require nss)
-     (apply clojure.test/run-tests nss))))

 (defmacro with-testing-data
   "Expects for all bindings the body to be evaluated to true. bindings


avoid aliases for semtag voice

avoid aliases for semtag voice

--- src/bolt/config.cljs
+++ src/bolt/config.cljs
@@ -34,8 +34,8 @@
     :devdocs {:alias "dev" :url "http://devdocs.io/#q=%s"} ;voice-trouble

     ;; semtag
-    :search {:alias "pss" :url "http://semtag.me#/search?query=%s"}
-    :regex-search {:alias "psr" :url "http://semtag.me#/search?query=%s&search-type=regex"}
+    :tag {:alias "pss" :url "http://semtag.me#/search?query=%s"}
+    :search {:alias "psr" :url "http://semtag.me#/search?query=%s&search-type=regex"}
     :type {:alias "pst" :url "http://semtag.me#/type/%s"}
     :thing {:alias "pse" :url "http://semtag.me#/thing/%s"} ;voice-trouble
     ;; local dev


add native-deps to dependencies for lein compatibility

--- src/cake/project.clj
+++ src/cake/project.clj
@@ -138,6 +138,7 @@
                :jar-name         (or (:jar-name opts) artifact-version)
                :war-name         (or (:war-name opts) artifact-version)
                :uberjar-name     (or (:uberjar-name opts) (str artifact-version "-standalone"))
-               :dependencies     (dep-map (or (:dependencies     opts) (:deps     opts)))
-               :dev-dependencies (dep-map (or (:dev-dependencies opts) (:dev-deps opts)))
-               :ext-dependencies (dep-map (or (:ext-dependencies opts) (:ext-deps opts)))))))
+               :dependencies     (dep-map (concat (:dependencies        opts) (:deps        opts)
+                                                  (:native-dependencies opts) (:native-deps opts)))
+               :dev-dependencies (dep-map (concat (:dev-dependencies    opts) (:dev-deps    opts)))
+               :ext-dependencies (dep-map (concat (:ext-dependencies    opts) (:ext-deps    opts)))))))


add key input for moving and rotating

add key input for moving and rotating

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -197,6 +197,49 @@
                      :position start-position))

 ;;------------------------------------------------------------
+;; Input-driven STATE CHANGES
+;;------------------------------------------------------------
+
+(def key-codes {:left 37
+                :up 38
+                :right 39
+                :down 40
+                :space 32})
+
+(defn try-move!
+  "Try moving the current piece to the given offset."
+  [dx dy]
+  (let [[x y] (:position @state)
+        piece (:piece @state)
+        board (:board @state)
+        nx (+ dx x)
+        ny (+ dy y)]
+    (if (piece-fits? piece nx ny board)
+      (swap! state assoc :position [nx ny]))))
+
+(defn try-rotate!
+  "Try rotating the current piece."
+  []
+  (let [[x y] (:position @state)
+        piece (:piece @state)
+        board (:board @state)
+        new-piece (rotate-piece piece)]
+    (if (piece-fits? new-piece x y board)
+      (swap! state assoc :piece new-piece))))
+
+(defn add-key-events
+  "Add all the key inputs."
+  []
+  (.addEventListener js/window "keydown"
+     (fn [e]
+       (let [code (aget e "keyCode")]
+         (cond
+           (= code (:down key-codes))  (do (try-move!  0  1) (.preventDefault e))
+           (= code (:left key-codes))  (do (try-move! -1  0) (.preventDefault e))
+           (= code (:right key-codes)) (do (try-move!  1  0) (.preventDefault e))
+           (= code (:up key-codes))    (do (try-rotate!)     (.preventDefault e)))))))
+
+;;------------------------------------------------------------
 ;; Facilities
 ;;------------------------------------------------------------

@@ -220,6 +263,7 @@
 (defn init []
   (size-canvas)
   (spawn-piece!)
+  (add-key-events)

   (connect-repl)
   (auto-refresh)


Disable default test

Disable default test

--- test/datemo/core_test.clj
+++ test/datemo/core_test.clj
@@ -2,6 +2,3 @@
   (:require [clojure.test :refer :all]
             [datemo.core :refer :all]))

-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))


Correctly parse three expression blocks.

* Was failing because of leaky pattern matching (see previous commit).

--- test/isla/test/parser.clj
+++ test/isla/test/parser.clj
@@ -65,11 +65,38 @@
                                   {:is [:is]}
                                   {:value [{:integer [2]}]}]}]}]}]}))

+
+
+(deftest three-expression-block
+  (check-ast (parse "name is 'Isla'\nwrite 'la'\nwrite name")
+             {:root [{:block [{:expression
+                               [{:assignment
+                                 [{:assignee ["name"]}
+                                  {:is [:is]}
+                                  {:value [{:string ["Isla"]}]}]}]}
+                              {:expression
+                               [{:invocation
+                                 [{:identifier ["write"]}
+                                  {:value [{:string ["la"]}]}]}]}
+                              {:expression
+                               [{:invocation
+                                 [{:identifier ["write"]}
+                                  {:value [{:identifier ["name"]}]}]}]}
+                              ]}]}))
+
+
 ;; invocation

 (deftest invoke-fn-one-param
   (check-ast (parse "write 'isla'")
              {:root [{:block [{:expression
-                               [{:assignment
+                               [{:invocation
                                  [{:identifier ["write"]}
                                   {:value [{:string ["isla"]}]}]}]}]}]}))
+
+(deftest test-write-string-regression
+  (check-ast (parse "write 'My name is Isla'")
+             {:root [{:block [{:expression
+                               [{:invocation
+                                 [{:identifier ["write"]}
+                                  {:value [{:string ["My name is Isla"]}]}]}]}]}]}))


Pass opts to pagination's nav

Pass opts to pagination's nav

- Use case for this is to pass a class of text-center to the containing
  nav, to center the pagination

--- src/om_bootstrap/pagination.cljs
+++ src/om_bootstrap/pagination.cljs
@@ -29,6 +29,6 @@
   (page (assoc opts :aria-label "Next") (d/span {:aria-hidden "true"} "»")))

 (s/defn pagination :- t/Component [opts & children]
-  (d/nav
+  (d/nav opts
     (d/ul {:class "pagination"}
           children)))


whitespace

whitespace

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -701,7 +701,6 @@
     :closure-defines {\"your-app.core.DEBUG_BANG_\" true}
     or
     :closure-defines {'your-app.core/DEBUG! true}"
-
   [sym default]
   (assert-args goog-define
    (core/or (core/string? default)


Proper set up for the GpioChannelProvider impl

--- src/main/clojure/gpio/core.clj
+++ src/main/clojure/gpio/core.clj
@@ -108,25 +108,27 @@
         read-ch (create-channel)
         mult-ch (a/mult read-ch)]

+    (.addFile poller (:file gpio-port) (bit-or EventPolling/EPOLLIN EventPolling/EPOLLET EventPolling/EPOLLPRI) gpio-port)
+
+    ; Serialize the write loop
     (go (loop []
           (when-let [data (<! write-ch)]
             (write-value! gpio-port data)
             (recur))))

     (go (loop []
-          (if-let [events (.poll poller -1)]
+          ; TODO: Let's use a timeout for more predictable shutdowns
+          (when-let [events (.poll poller 1000)]
             (doseq [_ (filter #(=  gpio-port (.getData %)) events)]
               (>! read-ch (read-value gpio-port)))
             (recur))))

-    (.addFile poller (:file gpio-port) (bit-or EventPolling/EPOLLIN EventPolling/EPOLLET EventPolling/EPOLLPRI) gpio-port)

     (reify
       GpioPort

       (set-direction! [_ direction] (set-direction! gpio-port direction))
       (set-active-low! [_ active-low?] (set-active-low! gpio-port active-low?))
-
       (read-value [_] (read-value gpio-port))

       (write-value! [this value] (>!! write-ch value))


fix broken hashbang prepend for :node-script target

--- src/main/shadow/build/node.clj
+++ src/main/shadow/build/node.clj
@@ -69,10 +69,9 @@
         module-opts
         (-> opts
             (select-keys [:prepend :append :prepend-js :append-js])
+            (update :prepend #(str "var shadow$provide = {};\n" %))
             (update :prepend #(str "(function(){\n" %))
             (cond->
-              (= :shadow (get-in state [:js-options :js-provider]))
-              (update :prepend #(str "var shadow$provide = {};\n" %))
               (not (false? (:hashbang opts)))
               (update :prepend #(str "#!/usr/bin/env node\n" %)))
             (update :append-js str "\n" main-call)


added headers for content type and charset to html responses

--- src/blog/web_server/web_server_impl.clj
+++ src/blog/web_server/web_server_impl.clj
@@ -3,6 +3,18 @@
   (:require [ring.middleware.session :as session]
             [ring.middleware.params :as params]
             [ring.adapter.jetty :as jetty]))
+
+(defn has-no-extension [{uri :uri}]
+  (empty? (re-find #"\.[A-Za-z0-9]+$" uri)))
+
+(defn wrap-content-type [handler]
+  (fn [req]
+    (let [{headers :headers :as resp} (handler req)
+          content-type (get headers "Content-Type")]
+      (if (and (empty? content-type)
+               (has-no-extension req))
+        (assoc-in resp [:headers "Content-Type"] "text/html;charset=UTF-8")
+        resp))))

 (defn wrap-handler [handler]
   (fn [req]
@@ -12,6 +24,7 @@

 (defn make-handler [handler]
   (-> (wrap-handler handler)
+      (wrap-content-type)
       (session/wrap-session)
       (params/wrap-params)))


transition phase function

transition phase function

--- src/cljs/love_letter_cljs/handlers.cljs
+++ src/cljs/love_letter_cljs/handlers.cljs
@@ -58,11 +58,6 @@
    (-> db
        (assoc-in [:active-card] face)
        (transition-phase :play face))))
-
-(defn transition-from-target-phase [db face]
-  (if (= :guard face)
-    (set-phase db :guard)
-    (set-phase db :resolution)))

 (register-handler
  :set-target


Fix bug in stats rendering of scale

Fix bug in stats rendering of scale

--- src/cljs/mandelbrot_cljs/rendering.cljs
+++ src/cljs/mandelbrot_cljs/rendering.cljs
@@ -111,7 +111,7 @@

         (swap! app-state update-in [:stats] assoc
                :render-speed render-speed
-               :scale (int scale)
+               :scale (long scale)
                :max-iterations max-iterations)

         (.log js/console "Done in: " render-speed "px/s")))))


Change file name generation: the prefix is used without modification.

--- src/clojure/ch/hood/odpg/impl/expdp.clj
+++ src/clojure/ch/hood/odpg/impl/expdp.clj
@@ -81,17 +81,16 @@
 				 (.get cal Calendar/DAY_OF_MONTH))))

 (defn render-header [{:keys [remote-link file-prefix directory]}]
-	(let [file-basename (str file-prefix "_" (render-today))]
-		(str/join "\n"
-							["declare"
-							 "handle number;"
-							 "job_state varchar2(50);"
-							 "begin"
-							 (str "handle := dbms_datapump.open('EXPORT', 'SCHEMA'"
-										(if (nil? remote-link) "" (str ", remote_link => " (single-quote remote-link))) ");")
-							 (c/render-add-file directory :dump-file file-basename)
-							 (c/render-add-file directory :exp-log-file file-basename)
-							 ])))
+	(str/join "\n"
+						["declare"
+						 "handle number;"
+						 "job_state varchar2(50);"
+						 "begin"
+						 (str "handle := dbms_datapump.open('EXPORT', 'SCHEMA'"
+									(if (nil? remote-link) "" (str ", remote_link => " (single-quote remote-link))) ");")
+						 (c/render-add-file directory :dump-file file-prefix)
+						 (c/render-add-file directory :exp-log-file file-prefix)
+						 ]))

 (defn validate [exp-data]
 	(let [schemas (:schemas exp-data)


macro may expand to non-object during inner trace

--- src/com/billpiel/sayid/inner_trace2.clj
+++ src/com/billpiel/sayid/inner_trace2.clj
@@ -464,9 +464,16 @@
                                      fn-meta
                                      path-chain'))))

+(defn with-meta-safe
+  [v m]
+  (try
+    (with-meta v m)
+    (catch Exception e
+      v)))
+
 (defn xpand-macro
   [head form src-map fn-meta path path-chain]
-  (let [xform (with-meta (macroexpand form) (meta form))] ;; TODO be sure this is doing something
+  (let [xform (with-meta-safe (macroexpand form) (meta form))] ;; TODO be sure this is doing something
     (let [path' (conj path :macro)
           path-chain' (conj path-chain path)]
       (xpand-macro-form head


Change the -p option from specifying packages to paths

--- src/radicalzephyr/boot_junit.clj
+++ src/radicalzephyr/boot_junit.clj
@@ -24,13 +24,13 @@

 (core/deftask junit
   "Run the jUnit test runner."
-  [p packages PACKAGE #{sym} "The set of Java packages to run tests in."]
+  [p paths    PATH  #{str} "The set of source paths to search for tests."]
   (let [worker-pods (pod/pod-pool (update-in (core/get-env) [:dependencies] into pod-deps)
                                   :init init)]
     (core/cleanup (worker-pods :shutdown))
     (core/with-pre-wrap fileset
       (let [worker-pod (worker-pods :refresh)
-            packages (or (seq packages)
+            packages (or (seq (map path->package-name paths))
                          (all-packages (core/input-files fileset)))]
         (if (seq packages)
           (let [result (pod/with-eval-in worker-pod


table-exists? now returns boolean instead of sequence of boolean.

--- tagcount/src/tagcount/migration.clj
+++ tagcount/src/tagcount/migration.clj
@@ -3,25 +3,26 @@
             [tagcount.core :as core]))

 (defn table-exists? [name]
-  (jdbc/query core/pooled-db-spec
-              ["select count(*)
-               from information_schema.tables
-               where table_schema = 'public'
-               and table_name = ?" name]
-              :row-fn #(> (:count %) 0)))
+  (first
+   (jdbc/query core/pooled-db-spec
+               ["select count(*)
+                from information_schema.tables
+                where table_schema = 'public'
+                and table_name = ?" name]
+               :row-fn #(> (:count %) 0))))

-(defn create-tagcount-table []
-  (if (not (table-exists? "tag_count"))
+(defn create-table [table]
+  (if-not (table-exists? table)
     (do
-      (println "Creating table tag_count...")
+      (println "Creating table" table)
       (jdbc/db-do-commands core/pooled-db-spec
                            (jdbc/create-table-ddl
-                             :tag_count
+                             (keyword table)
                              [:tag "varchar(140)" "PRIMARY KEY"]
                              [:count "int" "NOT NULL" "DEFAULT 0"]
                              [:valid_to "timestamptz" "NOT NULL"])))
-    (println "Table tag_count already exists.")))
+    (println "Table" table "already exists.")))

 (defn -main []
-  (create-tagcount-table)
+  (create-table "tag_count")
   (println "Done!"))


Make move percentages public

Make move percentages public

--- src/obb_rules/actions/move.clj
+++ src/obb_rules/actions/move.clj
@@ -3,8 +3,8 @@
             [obb-rules.game :as game])
   (:use obb-rules.result obb-rules.board obb-rules.element obb-rules.unit))

-(def ^:private min-move-percentage 0.2)
-(def ^:private max-move-percentage (- 1 min-move-percentage))
+(def min-move-percentage 0.2)
+(def max-move-percentage (- 1 min-move-percentage))

 (defn- invalid-move-percentage?
   "Checks if a quantity to move is invalid"


Add debug logging.

Add debug logging.

--- src/kixi/hecuba/data/validate.clj
+++ src/kixi/hecuba/data/validate.clj
@@ -4,6 +4,7 @@
            [clj-time.coerce :as tc]
            [kixi.hecuba.data.misc :as m]
            [kixi.hecuba.storage.db :as db]
+           [clojure.tools.logging :as log]
            [qbits.hayt :as hayt]))

 (defn larger-than-median
@@ -56,6 +57,7 @@
    (.after max-date upper_ts) {:upper_ts max-date}))

 (defn columns-to-update [sensor start end new-bounds]
+  (log/debugf "Sensor: %s Start: %s End: %s New-bounds: %s" sensor start end new-bounds)
   (merge
    (when-let [rollups (update-date-range sensor :rollups start end)]
      {:rollups [+ rollups]})


加一下忽略的文件

加一下忽略的文件

--- src/learnclojure/chapt3/core5.clj
+++ src/learnclojure/chapt3/core5.clj
@@ -21,4 +21,30 @@
 (nth 42 0)
 ;;clojure中的vector本身就支持nth语义，比调用nth更方便
 (def v [1 2 3])
-(v 0)+(v 0)
+
+;;栈 stack
+;;clojure没有独立的栈集合，它通过三个操作来支持这种语义
+;;用conj把一个值加入栈
+;;用pop获取栈顶的元素，并且移除这个值
+;;用peek获取栈顶的元素，但不移除这个值
+;;list和vector都可以作为栈，栈顶都是conj可以高效添加元素的一端
+
+;;list作为栈
+(conj '() 1)
+(conj '(2 1) 3)
+(peek '(3 2 1))
+(pop '(3 2 1))
+(pop '(1))
+
+;;vector作为栈
+(conj [] 1)
+(conj [1 2] 3)
+(peek [1 2 3])
+(pop [1 2 3])
+(pop [1])
+
+;;对一个空栈调用pop会报错
+;;(pop [])
+
+


Move #'vec call to inside mapping.

Move #'vec call to inside mapping.

The synonyms function doesn't need its output to be a vector.

As it is the index mapping that cares, it should be responsible
for the conversion.

--- src/haystack/create_index.clj
+++ src/haystack/create_index.clj
@@ -36,8 +36,7 @@
   []
   (let [groups (map #(string/split % #" ") synonym-list)
         syns (map (fn [[main & others]] (map #(string/join #"," [main %]) others)) groups)]
-    (vec (flatten syns))))
-
+    (flatten syns)))
 ;; (synonyms)

 (def ecommerce-mapping-types
@@ -80,7 +79,7 @@
         :snowball-filter {:type "snowball"
                           :language "English"}
         :synonym-filter {:type "synonym"
-                         :synonyms (synonyms)}
+                         :synonyms (vec (synonyms))}
         }

        :tokenizer


term->postings returns empty list if null postings

--- src/help_me_im_dumb/index.clj
+++ src/help_me_im_dumb/index.clj
@@ -23,12 +23,15 @@

 (defn term->postings
   [term]
-  (-> (some
-       #(when (.startsWith % term) %)
-       (line-seq (io/reader POSTINGS-LIST-FILENAME)))
-      (s/split #"\t")
-      second
-      (s/split #";")))
+  (let [plist (some
+               #(when (.startsWith % term) %)
+               (line-seq (io/reader POSTINGS-LIST-FILENAME)))]
+    (if (some? plist)
+      (-> plist
+          (s/split #"\t")
+          second
+          (s/split #";"))
+      '())))

 (defn create-indicies
   "Main function for creating indicies.


added ondisk url implementation

added ondisk url implementation

--- src/help_me_im_dumb/index.clj
+++ src/help_me_im_dumb/index.clj
@@ -5,12 +5,21 @@

 (def DICTIONARY-FILENAME "resources/dictionary.txt")
 (def POSTINGS-LIST-FILENAME "resources/postings.txt")
+(def URL-MAPPING-FILENAME "resources/url-mapping.txt")

-(declare token-seq-from-file create-sorted-term-postings-mapping write-term-postings-mapping-to-files read-in-dictionary)
+(declare create-indicies-helper read-in-dictionary)

 (defn initialize-index
   []
   (def DICTIONARY (read-in-dictionary)))
+
+(defn docid->url
+  [docid]
+  (-> (some
+       #(when (.startsWith % docid) %)
+       (line-seq (io/reader URL-MAPPING-FILENAME)))
+      (s/split #"\t")
+      second))

 (defn term->postings
   [term]
@@ -25,9 +34,7 @@
   "Main function for creating indicies.
    Reads in datafile, tokenizes, sorts, and writes to files"
   [jsonfile]
-  (->> (token-seq-from-file jsonfile)
-       create-sorted-term-postings-mapping
-       write-term-postings-mapping-to-files))
+  (create-indicies-helper jsonfile))

 (defn read-in-dictionary
   []
@@ -37,6 +44,13 @@
   [tokens]
   (map s/lower-case tokens))

+(defn sanitize-tokens
+  [tokens]
+  (-> tokens
+      (clojure.string/replace #"[^a-zA-Z\s]" "")
+      (clojure.string/split #"\s+")
+      normalize-tokens))
+
 (defn get-tokens-from-doc
   "Takes reddit doc from json data"
   [doc]
@@ -45,22 +59,26 @@
         url (doc "url")
         comments (doc "comments")
         comment-string (concat (map #(get % "text") comments))]
-    (->
-     (apply str body " " comment-string)
-     (clojure.string/replace #"[^a-zA-Z\s]" "")
-     (clojure.string/split #"\s+")
-     normalize-tokens)))
+    {:url url :text (sanitize-tokens (apply str body " " comment-string))}))

-(defn token-seq-from-file
-  "Returns [docid token] lazy seq from file"
+(defn doc-seq-from-file
+  "Returns doc lazy seq from file"
   [json-datafile]
+  (map
+   (fn [line id]
+     (assoc (get-tokens-from-doc (json/read-str line)) :id id))
+   (line-seq (io/reader json-datafile))
+   (iterate inc 0)))
+
+(defn token-seq-from-docs
+  "Returns [id term] from doc-seq"
+  [doc-seq]
   (apply
    concat
    (map
-    (fn [line id]
-      (map #(vector id %) (get-tokens-from-doc (json/read-str line))))
-    (line-seq (io/reader json-datafile))
-    (iterate inc 0))))
+    (fn [{id :id tokens :text}]
+      (map #(vector id %) tokens))
+    doc-seq)))

 (defn sort-id-token-pairs
   "Sorts id token pairs
@@ -99,4 +117,25 @@
       (.write postings-list-file
               (str term "\t" (clojure.string/join ";" postings) "\n")))))

+(defn write-url-mapping-to-file
+  [url-seq]
+  (with-open [url-mapping-file (io/writer URL-MAPPING-FILENAME)]
+    (doseq [[doc-id url] url-seq]
+      (.write url-mapping-file
+              (str doc-id "\t" url "\n")))))

+(defn create-url-seq
+  [doc-seq]
+  (map (fn [{id :id url :url}] [id url]) doc-seq))
+
+(defn create-indicies-helper
+  "Main function for creating indicies.
+   Reads in datafile, tokenizes, sorts, and writes to files"
+  [jsonfile]
+  (let [docs (doc-seq-from-file jsonfile)
+        token-seq (token-seq-from-docs docs)
+        url-seq (create-url-seq docs)]
+    (-> token-seq ;; Write term postings to file
+        create-sorted-term-postings-mapping
+        write-term-postings-mapping-to-files)
+    (write-url-mapping-to-file url-seq)))


Make all tests pass.

Make all tests pass.

--- test/boefie_invest/db/core_test.clj
+++ test/boefie_invest/db/core_test.clj
@@ -168,14 +168,14 @@

 (defn db-read-date
   [securities read-date]
-  (defentity sel2 (table (subselect securities) :sel2))
+  (defentity sel2 (table (subselect securities
+                                    (where {:date_added [<= (to-sql-time read-date)]})) :sel2))
   (select securities
           (fields :securities.date_added :securities.name :securities.isin)
           (join sel2 {:securities.date_added [< :sel2.date_added]
                       :securities.isin [= :sel2.isin]})
           (where {:sel2.isin nil
                   :date_added [<= (to-sql-time read-date)]})))
-

 (defn mytest
   [order]


improve compact test

improve compact test

--- test/com/rpl/specter/core_test.cljc
+++ test/com/rpl/specter/core_test.cljc
@@ -1668,7 +1668,7 @@
   (is (= {} (setval [:a (s/compact :b :c)] s/NONE {:a {:b {:c 1}}})))
   (is (= {:a {:d 2}} (setval [:a (s/compact :b :c)] s/NONE {:a {:b {:c 1} :d 2}})))
   (let [TREE-VALUES (recursive-path [] p (s/if-path vector? [(s/compact s/ALL) p] s/STAY))
-        tree [1 [2 3] [4 [[5] [[6]]]]]]
+        tree [1 [2 3] [] [4 [[5] [[6]]]]]]
     (is (= [2 4 6] (select [TREE-VALUES even?] tree)))
     (is (= [1 [3] [[[5]]]] (setval [TREE-VALUES even?] s/NONE tree)))
     )


finish test for inline caching

finish test for inline caching

--- test/com/rpl/specter/core_test.cljx
+++ test/com/rpl/specter/core_test.cljx
@@ -908,18 +908,24 @@
     [{:a 1 :b 2} {:a 10 :b 6} {:c 7 :b 8} {:c 1 :d 9} {:c 3 :d -1}]
     [[:a :b] [:b :a] [:c :d] [:b :c]]
     )
-  ;; TODO: test exception thrown when can't cache and must-cache-paths!
-  )
-
-;;TODO:
-;; make a macro to help with testing inline caching
-;;  - put into test-helpers
-;;  - do must-cache-paths!
-;;  - take in params vec, path expression, data, transform fn, and sequence of param vecs
-;;  - verify that functional version gets same result as inline
-;;    caching version run on the data multiple times (make sure same callsite)
-;;  - have another test that turns must-cache-paths on and verifies certain paths
-;;    don't cache (but still run with must-cache-paths off)
-
-
-
+
+  (s/must-cache-paths!)
+  (is (thrown? #+clj Exception #+cljs js/Error
+    (select (if true :a :b) nil)
+    ))
+  (is (thrown? #+clj Exception #+cljs js/Error
+    (select (*APATH* :a) nil)
+    ))
+  (is (thrown? #+clj Exception #+cljs js/Error
+    (select [:a (identity even?)] {:a 2})
+    ))
+  (let [p :a]
+    (is (thrown? #+clj Exception #+cljs js/Error
+      (select [p even?] {:a 2})
+      )))
+  (let [p :a]
+    (is (thrown? #+clj Exception #+cljs js/Error
+      (select [s/ALL (s/selected? p even?)] [{:a 2}])
+      )))
+  (s/must-cache-paths! false)
+  )


Adaptation sur CSB en Clojure

Adaptation sur CSB en Clojure

--- clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
+++ clojure/codingame/competition/coders-strike-back/src/coders_strike_back/core.clj
@@ -1,7 +1,11 @@
 (ns coders-strike-back.core
   (:gen-class))

-(def checkpoint-core-size 100)
+(def checkpoint-core-size 50)
+(def max-loop-before-boost 3)
+(def max-loop-before-shield 10)
+(def pod-radius 400)
+(def checkpoint-radius 600)

 (defn inc-atom [curr-val] (inc curr-val))
 (defn dec-atom [curr-val] (dec curr-val))
@@ -32,11 +36,12 @@
 (defn after [val1 val2] (if (> (- val2 val1) 0) true false))
 (defn before [val1 val2] (if (< (- val2 val1) 0) true false))

-;;Compute a boost value between 0 and 100
-(defn compute-boost [next-checkpoint-distance next-checkpoint-angle]
+;;Compute a thrust value between 0 and 100
+(defn compute-thrust [next-checkpoint-distance next-checkpoint-angle]
   (cond
     (> (Math/abs next-checkpoint-angle) 90) "0"
-    (and (< next-checkpoint-distance 1000) (> (Math/abs next-checkpoint-angle) 30)) "0"
+    (and (< next-checkpoint-distance 1000) (> (Math/abs next-checkpoint-angle) 25)) "0"
+    ; (and (< next-checkpoint-distance 1000) (< (Math/abs next-checkpoint-angle) 30)) "50"
     ; (< (Math/abs next-checkpoint-angle) 30) "100"
     ; (> next-checkpoint-distance 4000) "100"
     true "100"))
@@ -62,11 +67,15 @@
 (def game-loop-counter (atom 0))

 ;;Compute BOOST, SHIELD or boost value between 0 and 100
-(defn compute-action [next-checkpoint-x next-checkpoint-y next-checkpoint-distance next-checkpoint-angle opponent-x opponent-y boost-used? game-loop-counter]
-      (if (and (not @boost-used?) (> @game-loop-counter 3) (< (Math/abs next-checkpoint-angle) 10) (> next-checkpoint-distance 4000))
-          (do (reset! boost-used? true)
-              "BOOST")
-          (compute-boost next-checkpoint-distance next-checkpoint-angle)))
+(defn compute-action [next-checkpoint-x next-checkpoint-y next-checkpoint-distance next-checkpoint-angle opponent-x opponent-y x y boost-used? game-loop-counter]
+      (cond
+       (and
+        (not @boost-used?)
+        (> @game-loop-counter max-loop-before-boost)
+        (< (Math/abs next-checkpoint-angle) 10)
+        (> next-checkpoint-distance 4000)) (do (reset! boost-used? true) "BOOST")
+       ;(and (> @game-loop-counter max-loop-before-shield) (<= (distance x y opponent-x opponent-y) (+ (* 2 pod-radius) 50))) "SHIELD"
+       true (compute-thrust next-checkpoint-distance next-checkpoint-angle)))

 (defn -main [& args]
       (while true
@@ -109,5 +118,6 @@
                            nextCheckpointX nextCheckpointY
                            nextCheckpointDist nextCheckpointAngle
                            opponentX opponentY
+                           x y
                            boost-used? game-loop-counter)))
         (println "")))


fix French test: s/Juan/Jean/

fix French test: s/Juan/Jean/

--- test/babel/test/fr.clj
+++ test/babel/test/fr.clj
@@ -185,5 +185,5 @@
 (deftest named-sentence
   (let [result (expression {:synsem {:sem {:pred :be-called
                                            :subj {:pred :lui}
-                                           :obj {:pred :Juan}}}})]
-    (is (= (fo result) "il l'appele Juan"))))
+                                           :obj {:pred :Jean}}}})]
+    (is (= (fo result) "il l'appele Jean"))))


Fix accidental rename of environment variable

--- test/rill/event_store/psql_test.clj
+++ test/rill/event_store/psql_test.clj
@@ -8,17 +8,17 @@
              :password (System/getenv "RILL_POSTGRES_PASSWORD")
              :hostname (System/getenv "RILL_POSTGRES_HOST")
              :port (System/getenv "RILL_POSTGRES_PORT")
-             :database (System/getenv "RILL_POSTGRES_DATABASE")})
+             :database (System/getenv "RILL_POSTGRES_DB")})

 (defn get-clean-psql-store! [config]
   (tools/clear-db! config)
   (psql-event-store (tools/connection config)))

 (deftest test-psql-store
-  (if (System/getenv "RILL_POSTGRES_DATABASE")
+  (if (System/getenv "RILL_POSTGRES_DB")
     (do (tools/load-schema! config)
         (test-store #(get-clean-psql-store! config)))
-    (println "Skipped tests for rill postgres backend. Set at least RILL_POSTGRES_DATABASE environment variable to configure and enable tests")))
+    (println "Skipped tests for rill postgres backend. Set at least RILL_POSTGRES_DB environment variable to configure and enable tests")))