[n.d.sqlite] Add 'transact' and 'query-scalar', refactor names

`db-action` functions are being renamed to just `action`, the old names
are left for now though.

--- src/clojure/neko/data/sqlite.clj
+++ src/clojure/neko/data/sqlite.clj
@@ -3,20 +3,26 @@

   Contains convenience functions to work with SQLite databases Android
   provides."
+  (:refer-clojure :exclude [update])
   (:require [clojure.string :as string])
   (:use [neko.context :only [context]])
   (:import [android.database.sqlite SQLiteDatabase SQLiteOpenHelper]
            neko.data.sqlite.SQLiteHelper
-           android.database.Cursor
+           [android.database Cursor CursorIndexOutOfBoundsException SQLException]
            [android.content ContentValues Context]
            [clojure.lang Keyword PersistentVector]))

 ;; ### Database initialization

-(def ^{:private true
-       :doc "Set of types available to be stored in a database. Byte
-  actually stands for array of bytes, or Blob in SQLite."}
-  supported-types #{Integer Long String Boolean Double Byte})
+(def ^:private supported-types
+  "Mapping of SQLite types to respective Java classes. Byte actually stands for
+  array of bytes, or Blob in SQLite."
+  {"integer" Integer
+   "long" Long
+   "text" String
+   "boolean" Boolean
+   "double" Double
+   "blob" Byte})

 (defn make-schema
   "Creates a schema from arguments and validates it."
@@ -24,22 +30,38 @@
   (assert (string? (:name schema)) ":name should be a String.")
   (assert (number? (:version schema)) ":version should be a number.")
   (assert (map? (:tables schema)) ":tables should be a map.")
-  (doseq [[table-name params] (:tables schema)]
-    (assert (keyword? table-name)
-            (str "Table name should be a keyword: " table-name))
-    (assert (map? params) (str "Table parameters should be a map: " table-name))
-    (assert (map? (:columns params))
-            (str "Table parameters should contain columns map: " table-name))
-    (doseq [[column-name col-params] (:columns params)]
-      (assert (keyword? column-name)
-              (str "Column name should be a keyword: " column-name))
-      (assert (map? col-params)
-              (str "Column parameters should be a map: " column-name))
-      (assert (supported-types (:type col-params))
-              (str "Type is not supported: " (:type col-params)))
-      (assert (:sql-type col-params)
-              (str "SQL type should be specified: " column-name))))
-  schema)
+  (assoc schema
+    :tables
+    (into
+     {} (for [[table-name params] (:tables schema)]
+          (do
+            (assert (keyword? table-name)
+                    (str "Table name should be a keyword: " table-name))
+            (assert (map? params)
+                    (str "Table parameters should be a map: " table-name))
+            (assert (map? (:columns params))
+                    (str "Table parameters should contain columns map: " table-name))
+            [table-name
+             (assoc params
+               :columns
+               (into
+                {} (for [[column-name col-params] (:columns params)]
+                     (do
+                       (assert (keyword? column-name)
+                               (str "Column name should be a keyword: " column-name))
+                       (assert (or (map? col-params) (class? Integer))
+                               (str "Column type should be a map or a string:"
+                                    column-name))
+                       (let [col-type (if (string? col-params)
+                                        col-params
+                                        (:sql-type col-params))
+                             java-type (-> (re-matches #"(\w+).*" col-type)
+                                           second supported-types)
+                             col-params {:type java-type
+                                         :sql-type col-type}]
+                         (assert java-type
+                                 (str "Type is not supported: " (:sql-type col-params)))
+                         [column-name col-params])))))])))))

 (defn- db-create-query
   "Generates a table creation query from the provided schema and table
@@ -59,8 +81,8 @@
   database version mismatch."
   {:forms '([context schema])}
   ([schema]
-     (println "One-argument version is deprecated. Please use (create-helper context schema)")
-     (create-helper context schema))
+   (println "One-argument version is deprecated. Please use (create-helper context schema)")
+   (create-helper context schema))
   ([^Context context, {:keys [name version tables] :as schema}]
    (SQLiteHelper. (.getApplicationContext context) name version
                   (for [table (keys tables)]
@@ -71,21 +93,22 @@
 ;; A wrapper around SQLiteDatabase to keep database and its schema
 ;; together.
 ;;
-(deftype TaggedDatabase [db schema])
+(deftype TaggedDatabase [^SQLiteDatabase db, schema])

 (defn get-database
   "Returns SQLiteDatabase instance for the given schema. Access-mode can be
   either `:read` or `:write`."
   {:forms '([context schema access-mode])}
   ([schema access-mode]
-     (println "Two-argument version is deprecated. Please use (get-database context schema access-mode)"))
+   (println "Two-argument version is deprecated. Please use (get-database context schema access-mode)")
+   (get-database context schema mode))
   ([context schema access-mode]
-     {:pre [(#{:read :write} access-mode)]}
-     (let [helper (create-helper context schema)]
-       (TaggedDatabase. (case access-mode
-                          :read (.getReadableDatabase helper)
-                          :write (.getWritableDatabase helper))
-                        schema))))
+   {:pre [(#{:read :write} access-mode)]}
+   (let [helper (create-helper context schema)]
+     (TaggedDatabase. (case access-mode
+                        :read (.getReadableDatabase helper)
+                        :write (.getWritableDatabase helper))
+                      schema))))

 ;; ### Data-SQL transformers

@@ -99,7 +122,7 @@
             :when (contains? data-map col)]
       (let [value (get data-map col)]
         (condp = type
-          Integer (.put cv (name col) ^Integer value)
+          Integer (.put cv (name col) ^Integer (int value))
           Long (.put cv (name col) ^Long value)
           Double (.put cv (name col) ^Double value)
           String (.put cv (name col) ^String value)
@@ -128,16 +151,16 @@
   key = value2 ...`. Nested vectors is supported."
   [k v]
   (let [k (name k)]
-   (condp #(= % (type %2)) v
-     PersistentVector (let [[op & values] v]
-                        (->> values
-                             (map (partial keyval-to-sql k))
-                             (interpose (str " " (name op) " "))
-                             string/join))
-     String (format "(%s = '%s')" k v)
-     Boolean (format "(%s = %s)" k (if v 1 0))
-     nil (format "(%s is NULL)" k)
-     (format "(%s = %s)" k v))))
+    (condp #(= % (type %2)) v
+      PersistentVector (let [[op & values] v]
+                         (->> values
+                              (map (partial keyval-to-sql k))
+                              (interpose (str " " (name op) " "))
+                              string/join))
+      String (format "(%s = '%s')" k v)
+      Boolean (format "(%s = %s)" k (if v 1 0))
+      nil (format "(%s is NULL)" k)
+      (format "(%s = %s)" k v))))

 ;; ### SQL operations

@@ -152,7 +175,7 @@
          (interpose " AND ")
          string/join)))

-(defn db-query
+(defn query
   "Executes SELECT statement against the database and returns a Cursor
   object with the results. `where` argument should be a map of column
   keywords to values."
@@ -161,8 +184,9 @@
                      keys
                      (map name)
                      into-array)]
-    (.query ^SQLiteDatabase (.db tagged-db) (name table-name) columns
+    (.query (.db tagged-db) (name table-name) columns
             (where-clause where) nil nil nil nil)))
+(def db-query query)

 (defn seq-cursor
   "Turns data from Cursor object into a lazy sequence. Takes database
@@ -172,7 +196,8 @@
   (let [columns (get-in (.schema tagged-db) [:tables table-name :columns])
         seq-fn (fn seq-fn []
                  (lazy-seq
-                  (when-not (.isAfterLast cursor)
+                  (if (.isAfterLast cursor)
+                    (.close cursor)
                     (let [v (reduce-kv
                              (fn [data i [column-name {type :type}]]
                                (assoc data column-name
@@ -182,23 +207,57 @@
                       (cons v (seq-fn))))))]
     (seq-fn)))

-(defn db-query-seq
+(defn query-seq
   "Executes a SELECT statement against the database and returns the
-  result in a sequence. Same as calling `seq-cursor` on `db-query` output."
+  result in a sequence. Same as calling `seq-cursor` on `query` output."
   [^TaggedDatabase tagged-db table-name where]
   (seq-cursor tagged-db table-name (db-query tagged-db table-name where)))
-
-(defn db-update
+(def db-query-seq query-seq)
+
+(defn query-scalar
+  "Executes a SELECT statement against the database on a column and returns a
+  scalar value. `column` can be either a keyword or string-keyword pair where
+  string denotes the aggregation function."
+  [^TaggedDatabase tagged-db table-name column where]
+  (let [[aggregator column] (if (vector? column)
+                              column [nil column])
+        type (get-in (.schema tagged-db)
+                     [:tables table-name :columns column :type])
+        where-cl (where-clause where)
+        query (format "select %s from %s %s"
+                      (if aggregator
+                        (str aggregator "(" (name column) ")")
+                        (name column))
+                      (name table-name)
+                      (if (seq where-cl)
+                        (str "where " where-cl) ""))]
+    (with-open [cursor (.rawQuery (.db tagged-db) query nil)]
+      (try (.moveToFirst cursor)
+           (get-value-from-cursor cursor 0 type)
+           (catch CursorIndexOutOfBoundsException e nil)))))
+
+(defn update
   "Executes UPDATE query against the database generated from set and
   where clauses given as maps where keys are column keywords."
   [^TaggedDatabase tagged-db table-name set where]
-  (.update ^SQLiteDatabase (.db tagged-db) (name table-name)
+  (.update (.db tagged-db) (name table-name)
            (map-to-content tagged-db table-name set)
            (where-clause where) nil))
-
-(defn db-insert
+(def db-update update)
+
+(defn insert
   "Executes INSERT query against the database generated from data-map
   where keys are column keywords."
   [^TaggedDatabase tagged-db table-name data-map]
-  (.insert ^SQLiteDatabase (.db tagged-db) (name table-name) nil
+  (.insert (.db tagged-db) (name table-name) nil
            (map-to-content tagged-db table-name data-map)))
+(def db-insert insert)
+
+(defmacro transact
+  "Wraps the code in beginTransaction-endTransaction calls for batch query
+  execution."
+  [db & body]
+  `(try (.beginTransaction (.db ~db))
+        ~@body
+        (.setTransactionSuccessful (.db ~db))
+        (finally (.endTransaction (.db ~db)))))


Convert variable query from GET to POST.

--- src/cmr/opendap/ous/variable.clj
+++ src/cmr/opendap/ous/variable.clj
@@ -226,14 +226,14 @@
   variables, if params does not contain any."
   [search-endpoint user-token {variable-ids :variables}]
   (if (seq variable-ids)
-    (let [url (str search-endpoint
-                   "/variables?"
-                   (build-query variable-ids))
-          _ (log/debug "Variables query to CMR:" url)
-          promise (request/async-get url
+    (let [url (str search-endpoint "/variables")
+          payload (build-query variable-ids)
+          _ (log/debug "Variables query to CMR:" payload)
+          promise (request/async-post url
                    (-> {}
                        (request/add-token-header user-token)
-                       (request/add-accept "application/vnd.nasa.cmr.umm+json"))
+                       (request/add-accept "application/vnd.nasa.cmr.umm+json")
+                       (request/add-payload ))
                    response/json-handler)]
       (log/debug "Variable ids used:" variable-ids)
       (extract-metadata promise))


Try conditionally using cljs pprint

Try conditionally using cljs pprint

--- src/com/frereth/common/util.cljc
+++ src/com/frereth/common/util.cljc
@@ -1,6 +1,10 @@
 (ns com.frereth.common.util
   (:require [clojure.edn :as edn]
-            [clojure.pprint :as pprint]
+            [#?
+             (:clj
+              clojure.pprint
+              :cljs cljs.pprint
+              :clr clojure.pprint) :as pprint]
             [clojure.string :as string]
             [com.frereth.common.schema :as fr-sch]
             #_[puget.printer :as puget]


GR - remove println

GR - remove println

--- src/d_cent/workflows/twitter.clj
+++ src/d_cent/workflows/twitter.clj
@@ -27,7 +27,6 @@
   (try
     (let [request-token-response (oauth/request-token consumer callback-url)
           approval-uri (oauth/user-approval-uri consumer (:oauth_token request-token-response))]
-      (println "Twitter sign in")
       (response/redirect approval-uri))
     (catch clojure.lang.ExceptionInfo e
       (do (log/warn (str "Could not get request token from twitter: " e))


Parametrize success-step

Parametrize success-step

--- test/icecap/test_data.clj
+++ test/icecap/test_data.clj
@@ -1,6 +1,6 @@
 (ns icecap.test-data)

-(def simple-step {:type :succeed})
+(defn success-step [name] {:type :succeed :name name})
 (def simple-http-step {:type :http :url "http://example.test"})
 (def simple-https-step {:type :http :url "https://example.test"})
 (def simple-ftp-step {:type :ftp :loc "ftp://example.test"})


Fix return value

Fix return value

--- src/discuss/references/main.cljs
+++ src/discuss/references/main.cljs
@@ -120,9 +120,10 @@
                                                          (lib/change-view! :create/argument))}
                         (t :create/argument :short)]]
                       (when (seq usages)
-                        [:hr]
-                        [:p.text-center (t :references :usages/list) "."]
-                        (map reference-usages-for-arguments usages))]
+                        [:div
+                         [:hr]
+                         [:p.text-center (t :references :usages/list) "."]
+                         (map reference-usages-for-arguments usages)])]
                      [:div.text-center
                       (vlib/view-header (t :references :usages/not-found-lead))
                       [:p (t :references :usages/not-found-body) "."]])]))))


List all arguments instead of only the first one

--- src/discuss/references/main.cljs
+++ src/discuss/references/main.cljs
@@ -66,22 +66,31 @@
                                 :onClick   #(lib/change-view! :reference-create-with-ref)}
                            "Springe in die Diskussion")))))

+(defn single-reference-usage
+  "Show single usage of a reference."
+  [data]
+  (reify om/IRender
+    (render [_]
+      (let [{:keys [issue argument author]} data]           ; TODO I think this should be the author of the argument
+        (bs/callout-info
+          (dom/div #js {:className "pull-right"}
+                   (bs/button-default-sm #(com/jump-to-argument (:slug issue) (:uid argument)) (vlib/fa-icon "fa-check") " Auswählen"))
+          (dom/a #js {:href    "javascript:void(0)"
+                      :onClick #(com/jump-to-argument (:slug issue) (:uid argument))}
+                 (dom/strong nil (vlib/safe-html (:text argument))))
+          (dom/div nil "Autor: " (:nickname author))
+          (dom/div nil "Diskussionsthema: " (:title issue)))))))
+
 (defn usage-list-view
   "List single usages of reference."
   [data]
   (reify om/IRender
     (render [_]
       (let [issue (:issue data)
-            argument (first (:arguments data))
+            arguments (:arguments data)
             author (:author data)]
-        (bs/callout-info
-          (dom/div #js {:className "pull-right"}
-                   (bs/button-default-sm #(com/jump-to-argument (:slug issue) (:uid argument)) (vlib/fa-icon "fa-check") " Auswählen"))
-          (dom/a #js {:href    "javascript:void(0)"
-                      :onClick #(com/jump-to-argument (:slug issue) (:uid argument))}
-                 (dom/strong nil (:text argument)))         ; TODO this should not be only the first one
-          (dom/div nil "Autor: " (:nickname author))
-          (dom/div nil "Diskussionsthema: " (:title issue)))))))
+        (apply dom/div nil
+               (map #(om/build single-reference-usage (lib/merge-react-key {:issue issue, :argument %, :author author})) arguments))))))

 (defn usages-view
   "List with details showing the usages of the given reference."


Comment typo.

Comment typo.

--- test/isla/test/parser.clj
+++ test/isla/test/parser.clj
@@ -50,7 +50,7 @@
                                   {:value [{:string ["cool"]}]}]}]}]}]}))

-;; ;; blocks
+;; blocks

 (deftest two-expression-block
   (check-ast (parse "isla is 1\nmary is 2")


Added check if job has any metadata

Added check if job has any metadata

--- src/emender_jenkins/rest_api.clj
+++ src/emender_jenkins/rest_api.clj
@@ -119,13 +119,13 @@

 (defn get-job-results
     [request uri]
-    (println uri)
     (let [job-name (uri->job-name uri "/api/get_job_results/")]
         (if job-name
-            (let [configuration (:configuration request)
-                  job-results   (jenkins-api/read-job-results job-name (-> configuration :jenkins :jenkins-url))]
-                 (send-plain-response job-results)))))
- ;                http://10.34.3.139:8080/view/Tests/job/doc-Red_Hat_Certificate_System-10.0-Administration_Guide-en-US%20(test)/lastSuccessfulBuild/artifact/results.json/*view*/
+            (let [job-metadata (results/find-job-with-name job-name)]
+                (if job-metadata
+                    (let [configuration (:configuration request)
+                          job-results   (jenkins-api/read-job-results job-name (-> configuration :jenkins :jenkins-url))]
+                         (send-plain-response job-results)))))))

 (defn job-started-handler
     [request]


deal with key-only

deal with key-only

--- src/er_cassandra/model/types.clj
+++ src/er_cassandra/model/types.clj
@@ -228,9 +228,11 @@
   "return true if the record has at least all columns of
    the entity uber-key"
   [entity record]
-  (let [r-cols (-> record keys set)
-        uk-cols (-> entity :primary-table :key flatten set)]
-    (empty? (set/difference uk-cols r-cols))))
+  (if (map? record)
+    (let [r-cols (-> record keys set)
+          uk-cols (-> entity :primary-table :key flatten set)]
+      (empty? (set/difference uk-cols r-cols)))
+    false))

 (defn satisfies-primary-key?
   "return true if key is the same as the full primary-key"


fix test

fix test


whitespace formatting in systems.clj

whitespace formatting in systems.clj

--- src/glory_of_empires/systems.clj
+++ src/glory_of_empires/systems.clj
@@ -2,96 +2,96 @@
   (:use clojure-common.utils))

 (def all-systems-arr
-  [ { :id :acheron  :image "1planet/Tile-Acheron.gif" }
-    { :id :aeon     :image "1planet/Tile-Aeon.gif" }
-    { :id :aker     :image "1planet/Tile-Aker.gif" }
-    { :id :ammit    :image "1planet/Tile-Ammit.gif" }
-    { :id :amun     :image "1planet/Tile-Amun.gif" }
-    { :id :andjety  :image "1planet/Tile-Andjety.gif" }
-    { :id :anhur    :image "1planet/Tile-Anhur.gif" }
-    { :id :ankh     :image "1planet/Tile-Ankh.gif" }
-    { :id :anuket   :image "1planet/Tile-Anuket.gif" }
-    { :id :apis     :image "1planet/Tile-Apis.gif" }
-    { :id :asgard   :image "1planet/Tile-Asgard.gif" }
-    { :id :asgard3  :image "1planet/Tile-Asgard_III.gif" }
-    { :id :astennu  :image "1planet/Tile-Astennu.gif" }
-    { :id :aten     :image "1planet/Tile-Aten.gif" }
-    { :id :babi     :image "1planet/Tile-Babi.gif" }
-    { :id :bakha    :image "1planet/Tile-Bakha.gif" }
-    { :id :bast     :image "1planet/Tile-Bast.gif" }
-    { :id :beriyil  :image "1planet/Tile-Beriyil.gif" }
-    { :id :bes      :image "1planet/Tile-Bes.gif" }
-    { :id :capha    :image "1planet/Tile-Capha.gif" }
-    { :id :chensit  :image "1planet/Tile-Chensit.gif" }
-    { :id :chnum    :image "1planet/Tile-Chnum.gif" }
-    { :id :chuuka   :image "1planet/Tile-Chuuka.gif" }
-    { :id :cicerus  :image "1planet/Tile-Cicerus.gif" }
+  [ { :id :acheron   :image "1planet/Tile-Acheron.gif" }
+    { :id :aeon      :image "1planet/Tile-Aeon.gif" }
+    { :id :aker      :image "1planet/Tile-Aker.gif" }
+    { :id :ammit     :image "1planet/Tile-Ammit.gif" }
+    { :id :amun      :image "1planet/Tile-Amun.gif" }
+    { :id :andjety   :image "1planet/Tile-Andjety.gif" }
+    { :id :anhur     :image "1planet/Tile-Anhur.gif" }
+    { :id :ankh      :image "1planet/Tile-Ankh.gif" }
+    { :id :anuket    :image "1planet/Tile-Anuket.gif" }
+    { :id :apis      :image "1planet/Tile-Apis.gif" }
+    { :id :asgard    :image "1planet/Tile-Asgard.gif" }
+    { :id :asgard3   :image "1planet/Tile-Asgard_III.gif" }
+    { :id :astennu   :image "1planet/Tile-Astennu.gif" }
+    { :id :aten      :image "1planet/Tile-Aten.gif" }
+    { :id :babi      :image "1planet/Tile-Babi.gif" }
+    { :id :bakha     :image "1planet/Tile-Bakha.gif" }
+    { :id :bast      :image "1planet/Tile-Bast.gif" }
+    { :id :beriyil   :image "1planet/Tile-Beriyil.gif" }
+    { :id :bes       :image "1planet/Tile-Bes.gif" }
+    { :id :capha     :image "1planet/Tile-Capha.gif" }
+    { :id :chensit   :image "1planet/Tile-Chensit.gif" }
+    { :id :chnum     :image "1planet/Tile-Chnum.gif" }
+    { :id :chuuka    :image "1planet/Tile-Chuuka.gif" }
+    { :id :cicerus   :image "1planet/Tile-Cicerus.gif" }
     { :id :coruscant :image "1planet/Tile-Coruscant.gif" }
-    { :id :dedun    :image "1planet/Tile-Dedun.gif" }
-    { :id :deimo    :image "1planet/Tile-Deimo.gif" }
+    { :id :dedun     :image "1planet/Tile-Dedun.gif" }
+    { :id :deimo     :image "1planet/Tile-Deimo.gif" }
     { :id :discworld :image "1planet/Tile-Discworld.gif" }
-    { :id :dune     :image "1planet/Tile-Dune.gif" }
-    { :id :elnath   :image "1planet/Tile-Elnath.gif" }
-    { :id :everra   :image "1planet/Tile-Everra.gif" }
-    { :id :faunus   :image "1planet/Tile-Faunus.gif" }
-    { :id :fiorina  :image "1planet/Tile-Fiorina.gif" }
-    { :id :floyd4   :image "1planet/Tile-FloydIV.gif" }
-    { :id :garbozia :image "1planet/Tile-Garbozia.gif" }
-    { :id :heimat   :image "1planet/Tile-Heimat.gif" }
+    { :id :dune      :image "1planet/Tile-Dune.gif" }
+    { :id :elnath    :image "1planet/Tile-Elnath.gif" }
+    { :id :everra    :image "1planet/Tile-Everra.gif" }
+    { :id :faunus    :image "1planet/Tile-Faunus.gif" }
+    { :id :fiorina   :image "1planet/Tile-Fiorina.gif" }
+    { :id :floyd4    :image "1planet/Tile-FloydIV.gif" }
+    { :id :garbozia  :image "1planet/Tile-Garbozia.gif" }
+    { :id :heimat    :image "1planet/Tile-Heimat.gif" }
     { :id :hopes-end :image "1planet/Tile-Hopes_End.gif" }
-    { :id :inaak    :image "1planet/Tile-Inaak.gif" }
+    { :id :inaak     :image "1planet/Tile-Inaak.gif" }
     { :id :industrex :image "1planet/Tile-Industrex.gif" }
-    { :id :iskra    :image "1planet/Tile-Iskra.gif" }
-    { :id :ithaki   :image "1planet/Tile-Ithaki.gif" }
-    { :id :kanite   :image "1planet/Tile-Kanite.gif" }
-    { :id :kauket   :image "1planet/Tile-Kauket.gif" }
+    { :id :iskra     :image "1planet/Tile-Iskra.gif" }
+    { :id :ithaki    :image "1planet/Tile-Ithaki.gif" }
+    { :id :kanite    :image "1planet/Tile-Kanite.gif" }
+    { :id :kauket    :image "1planet/Tile-Kauket.gif" }
     { :id :kazenoeki :image "1planet/Tile-Kazenoeki.gif" }
-    { :id :khepri   :image "1planet/Tile-Khepri.gif" }
-    { :id :khnum    :image "1planet/Tile-Khnum.gif" }
+    { :id :khepri    :image "1planet/Tile-Khepri.gif" }
+    { :id :khnum     :image "1planet/Tile-Khnum.gif" }
     { :id :klendathu :image "1planet/Tile-Klendathu.gif" }
-    { :id :kobol    :image "1planet/Tile-Kobol.gif" }
-    { :id :laurin   :image "1planet/Tile-Laurin.gif" }
-    { :id :lesab    :image "1planet/Tile-Lesab.gif" }
-    { :id :lodor    :image "1planet/Tile-Lodor.gif" }
-    { :id :lv426    :image "1planet/Tile-Lv426.gif" }
-    { :id :medusa-v :image "1planet/Tile-Medusa_V.gif" }
+    { :id :kobol     :image "1planet/Tile-Kobol.gif" }
+    { :id :laurin    :image "1planet/Tile-Laurin.gif" }
+    { :id :lesab     :image "1planet/Tile-Lesab.gif" }
+    { :id :lodor     :image "1planet/Tile-Lodor.gif" }
+    { :id :lv426     :image "1planet/Tile-Lv426.gif" }
+    { :id :medusa-v  :image "1planet/Tile-Medusa_V.gif" }
     { :id :mehar-xull :image "1planet/Tile-Mehar_Xull.gif" }
-    { :id :mirage   :image "1planet/Tile-Mirage.gif" }
-    { :id :myrkr    :image "1planet/Tile-Myrkr.gif" }
-    { :id :nanan    :image "1planet/Tile-Nanan.gif" }
-    { :id :natthar  :image "1planet/Tile-Natthar.gif" }
-    { :id :nef      :image "1planet/Tile-Nef.gif" }
-    { :id :nexus    :image "1planet/Tile-Nexus.gif" }
+    { :id :mirage    :image "1planet/Tile-Mirage.gif" }
+    { :id :myrkr     :image "1planet/Tile-Myrkr.gif" }
+    { :id :nanan     :image "1planet/Tile-Nanan.gif" }
+    { :id :natthar   :image "1planet/Tile-Natthar.gif" }
+    { :id :nef       :image "1planet/Tile-Nef.gif" }
+    { :id :nexus     :image "1planet/Tile-Nexus.gif" }
     { :id :niiwa-sei :image "1planet/Tile-Niiwa-Sei.gif" }
-    { :id :pakhet   :image "1planet/Tile-Pakhet.gif" }
-    { :id :parzifal :image "1planet/Tile-Parzifal.gif" }
+    { :id :pakhet    :image "1planet/Tile-Pakhet.gif" }
+    { :id :parzifal  :image "1planet/Tile-Parzifal.gif" }
     { :id :perimeter :image "1planet/Tile-Perimeter.gif" }
-    { :id :petbe    :image "1planet/Tile-Petbe.gif" }
-    { :id :primor   :image "1planet/Tile-Primor.gif" }
-    { :id :ptah     :image "1planet/Tile-Ptah.gif" }
-    { :id :qetesh   :image "1planet/Tile-Qetesh.gif" }
-    { :id :quann    :image "1planet/Tile-Quann.gif" }
-    { :id :radon    :image "1planet/Tile-Radon.gif" }
-    { :id :saudor   :image "1planet/Tile-Saudor.gif" }
-    { :id :sem-lore :image "1planet/Tile-Sem-Lore.gif" }
-    { :id :shai     :image "1planet/Tile-Shai.gif" }
-    { :id :shool    :image "1planet/Tile-Shool.gif" }
-    { :id :solitude :image "1planet/Tile-Solitude.gif" }
-    { :id :sulako   :image "1planet/Tile-Sulako.gif" }
-    { :id :suuth    :image "1planet/Tile-Suuth.gif" }
-    { :id :tarmann  :image "1planet/Tile-Tarmann.gif" }
-    { :id :tefnut   :image "1planet/Tile-Tefnut.gif" }
-    { :id :tempesta :image "1planet/Tile-Tempesta.gif" }
-    { :id :tenenit :image "1planet/Tile-Tenenit.gif" }
-    { :id :theom :image "1planet/Tile-Theom.gif" }
-    { :id :thibah :image "1planet/Tile-Thibah.gif" }
-    { :id :ubuntu :image "1planet/Tile-Ubuntu.gif" }
-    { :id :vefut2 :image "1planet/Tile-Vefut_II.gif" }
-    { :id :wadjet :image "1planet/Tile-Wadjet.gif" }
-    { :id :wellon :image "1planet/Tile-Wellon.gif" }
-    { :id :wepwawet :image "1planet/Tile-Wepwawet.gif" }
+    { :id :petbe     :image "1planet/Tile-Petbe.gif" }
+    { :id :primor    :image "1planet/Tile-Primor.gif" }
+    { :id :ptah      :image "1planet/Tile-Ptah.gif" }
+    { :id :qetesh    :image "1planet/Tile-Qetesh.gif" }
+    { :id :quann     :image "1planet/Tile-Quann.gif" }
+    { :id :radon     :image "1planet/Tile-Radon.gif" }
+    { :id :saudor    :image "1planet/Tile-Saudor.gif" }
+    { :id :sem-lore  :image "1planet/Tile-Sem-Lore.gif" }
+    { :id :shai      :image "1planet/Tile-Shai.gif" }
+    { :id :shool     :image "1planet/Tile-Shool.gif" }
+    { :id :solitude  :image "1planet/Tile-Solitude.gif" }
+    { :id :sulako    :image "1planet/Tile-Sulako.gif" }
+    { :id :suuth     :image "1planet/Tile-Suuth.gif" }
+    { :id :tarmann   :image "1planet/Tile-Tarmann.gif" }
+    { :id :tefnut    :image "1planet/Tile-Tefnut.gif" }
+    { :id :tempesta  :image "1planet/Tile-Tempesta.gif" }
+    { :id :tenenit   :image "1planet/Tile-Tenenit.gif" }
+    { :id :theom     :image "1planet/Tile-Theom.gif" }
+    { :id :thibah    :image "1planet/Tile-Thibah.gif" }
+    { :id :ubuntu    :image "1planet/Tile-Ubuntu.gif" }
+    { :id :vefut2    :image "1planet/Tile-Vefut_II.gif" }
+    { :id :wadjet    :image "1planet/Tile-Wadjet.gif" }
+    { :id :wellon    :image "1planet/Tile-Wellon.gif" }
+    { :id :wepwawet  :image "1planet/Tile-Wepwawet.gif" }
     { :id :abyz-fria :image "2planet/Tile-Abyz-Fria.gif" }
-    { :id :achill :image "2planet/Tile-Achill.gif" }
+    { :id :achill    :image "2planet/Tile-Achill.gif" }
     { :id :aeterna-tammuz :image "2planet/Tile-AeternaTammuz.gif" }
     { :id :arinam-meer :image "2planet/Tile-Arinam-Meer.gif" }
     { :id :arnor-lor :image "2planet/Tile-Arnor-Lor.gif" }


Remove define-dispatch-table

Remove define-dispatch-table

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -155,10 +155,6 @@
                   dt)
               :else nil))))))

-#_
-(defmacro define-dispatch-table [name & opts-and-entries]
-  (def ~name `(compile-dispatch-table ~@opts-and-entries)))
-
 (defn default-pipeline [handler]
   (-> handler
     rook/wrap-with-function-arg-resolvers


add docstrings for csv export functions

add docstrings for csv export functions

--- src/kixi/hecuba/api/profiles.clj
+++ src/kixi/hecuba/api/profiles.clj
@@ -583,6 +583,10 @@
       :schema  airflow-measurement-schema }])

 (defn explode-nested-item [association item-string]
+  "Explodes a nested item, that is represented in the object coming from
+  the datastore as a json encoded string. Returns a list of vectors of
+  two elements, the first being the attribute key, and the second the value.
+  The key is expanded to <nested item name>_<attribute name>"
   (let [item (json/decode item-string)
         association-name   (:name   association)
         association-schema (:schema association)]
@@ -592,6 +596,11 @@
      association-schema)))

 (defn explode-associated-items [association items]
+  "Explodes the elements of a (one to many) association, that is represented
+  in the object coming from the datastore as a list of json encoded strings.
+  Returns a list of vectors of two elements, the first being the attribute key,
+  and the second the value.
+  The keys are expanded like <association name>_<associated item index>_<attribute name>"
   (let [association-name   (name (:name    association))
         association-schema (:schema  association)]
     (apply concat
@@ -605,6 +614,9 @@
       items))))

 (defn explode-and-sort-by-schema [item schema]
+  "Take a (profile) item from the datastore and converts into a list
+  of pairs (represented as a vector) where the first element is the
+  exploded key for the attribute and the second is the value"
   (let [exploded-item
          (mapcat
            (fn [attr]
@@ -677,7 +689,7 @@
   Example:

   attribute type | attribute name              | exploded name              |
-  standaed       | timestamp                   | timestamp                  |
+  standard       | timestamp                   | timestamp                  |
   nested item    | profile_data, bedroom_count | profile_data_bedroom_count |
   association    | storeys, first storey_type  | storeys_0_storey_type      |"
   (reduce
@@ -702,6 +714,7 @@
                                (parse-by-schema body-map profile-schema))
                              decoded-body)]
               ;; We need to assert a few things
+
               (if (not= (:entity_id body) entity_id)
                 true                  ; it's malformed, game over
                 [false {:body body}]))  ; it's not malformed, return the body now we've read it


support passing the archs to build on the command line

--- src/leiningen/compile_native.clj
+++ src/leiningen/compile_native.clj
@@ -75,8 +75,12 @@
   (make-native target os arch-flag)
   (make-java   target os arch-flag))

-(defn compile-native [project]
-  (doseq [[arch arch-flag] {"x86_64" "-m64", "x86" "-m32"}]
+(def arch-flags {"x86_64" "-m64", "x86" "-m32"})
+
+(defn compile-native [project & archs]
+  (doseq [[arch arch-flag] (if (seq archs)
+                             (select-keys arch-flags archs)
+                             arch-flags)]
     (let [os     (name (get-os))
           target (file (:target-path project) os arch)
           dest   (file "resources" "native" os arch)]


filter lists start out as empty

filter lists start out as empty

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/sidebar/command.cljs
+++ src/lt/objs/sidebar/command.cljs
@@ -284,7 +284,7 @@
                               lis (for [x (range (:size opts))]
                                          (item this x))]
                           (object/merge! this (merge {:lis (vec lis)} opts))
-                          [:div.filter-list
+                          [:div.filter-list.empty
                            (input this)
                            [:ul
                             lis]


shorten the name of the version caches

shorten the name of the version caches

--- src/main/cljs_api_gen/config.clj
+++ src/main/cljs_api_gen/config.clj
@@ -6,7 +6,7 @@
 (def cljsdoc-dir "cljsdoc")

 ;; cache directory
-(defn edn-parsed-file [v] (str "cljs-api-parsed-" v ".edn"))
+(defn edn-parsed-file [v] (str v ".edn"))
 (defn edn-result-file [v] (str "cljs-api-" v ".edn"))

 ;; location of the clojure & clojurescript repos to parse


Cache session creation by default, as discusined in issue #28

--- src/main/clojure/clara/rules.clj
+++ src/main/clojure/clara/rules.clj
@@ -157,39 +157,63 @@
       (eng/shred-rules)
       (eng/compile-shredded-rules)))

+;; Cache of sessions for fast reloading.
+(def ^:private session-cache (atom {}))
+
 (defn mk-session*
   "Creates a new session using the given rule source. Thew resulting session
    is immutable, and can be used with insert, retract, fire-rules, and query functions."
   ([source & more]
-     ;; Merge all of the sources together and create a session.
-     (let [rulebase (eng/load-rules source)
-           transport (LocalTransport.)
-           other-sources (take-while (complement keyword?) more)
-           options (apply hash-map (drop-while (complement keyword?) more))
-
-           ;; Merge other rule sessions into one.
-           merged-rules (reduce
-                         (fn [rulebase other-source]
-                           (eng/conj-rulebases rulebase (eng/load-rules other-source)))
-                         (eng/load-rules source)
-                         other-sources)
-
-           ;; The fact-type uses Clojure's type function unless overridden.
-           fact-type-fn (get options :fact-type-fn type)
-
-           ;; Create a function that groups a sequence of facts by the collection
-           ;; of alpha nodes they target.
-           ;; We cache an alpha-map for facts of a given type to avoid computing
-           ;; them for every fact entered.
-           get-alphas-fn (eng/create-get-alphas-fn fact-type-fn merged-rules)]
-
-       (LocalSession. merged-rules (eng/local-memory merged-rules transport) transport get-alphas-fn))))
+
+     ;; If an equivalent session has been created, simply reuse it.
+     ;; This essentially memoizes this function unless the caller disables caching.
+     (if-let [session (get @session-cache [source more])]
+       session
+
+       ;; Merge all of the sources together and create a session.
+       (let [rulebase (eng/load-rules source)
+             transport (LocalTransport.)
+             other-sources (take-while (complement keyword?) more)
+             options (apply hash-map (drop-while (complement keyword?) more))
+
+             ;; Merge other rule sessions into one.
+             merged-rules (reduce
+                           (fn [rulebase other-source]
+                             (eng/conj-rulebases rulebase (eng/load-rules other-source)))
+                           (eng/load-rules source)
+                           other-sources)
+
+             ;; The fact-type uses Clojure's type function unless overridden.
+             fact-type-fn (get options :fact-type-fn type)
+
+             ;; Create a function that groups a sequence of facts by the collection
+             ;; of alpha nodes they target.
+             ;; We cache an alpha-map for facts of a given type to avoid computing
+             ;; them for every fact entered.
+             get-alphas-fn (eng/create-get-alphas-fn fact-type-fn merged-rules)
+
+             session (LocalSession. merged-rules (eng/local-memory merged-rules transport) transport get-alphas-fn)]
+
+         ;; Cache the session unless instructed not to.
+         (when (get options :cache true)
+           (swap! session-cache assoc [source more] session))
+
+         ;; Return the session.
+         session))))

 (defmacro mk-session
    "Creates a new session using the given rule sources. Thew resulting session
    is immutable, and can be used with insert, retract, fire-rules, and query functions.

-   If no sources are provided, it will attempt to load rules from the caller's namespace."
+   If no sources are provided, it will attempt to load rules from the caller's namespace.
+
+   The caller may also specify keyword-style options at the end of the parameters. Currently two
+   options are supported:
+
+   * :fact-type-fn, which must have a value of a function used to determine the logical type of a given
+     cache. Defaults to Clojures type function.
+   * :cache, indicating whether the session creation can be cached, effectively memoizing mk-session.
+     Defaults to true. Callers may wish to set this to false when needing to dynamically reload rules."
   [& args]
   (if (and (seq args) (not (keyword? (first args))))
     `(apply mk-session* ~(vec args)) ; At least one namespace given, so use it.


add stub functions

add stub functions

--- src/graphql_clj/execution.clj
+++ src/graphql_clj/execution.clj
@@ -46,20 +46,58 @@
       :list-type (:type field)
       (gerror/throw-error (format "Unhandled field type: %s (name = %s)." field field-name)))))

-(defn- execute-field [parent-type parent-value fields field-type state]
-  nil)
+(defn- resolve-field-value
+  "6.4.2 Value Resolution
+
+  While nearly all of GraphQL execution can be described generically,
+  ultimately the internal system exposing the GraphQL interface must
+  provide values. This is exposed via ResolveFieldValue, which
+  produces a value for a given field on a type for a real value."
+  [{:keys [resolver-fn name arguments] :as field}
+   {:keys [context resolver variables] :as state}
+   parent-type-name parent-value]
+  (let [field-name (:name field)
+        resolver (or resolver-fn
+                     (resolver (str parent-type-name) (str name)))
+        default-arguments nil
+        args nil]
+    (resolver context parent-value args)))
+
+(defn- complete-value
+  "6.4.3 Value Completion
+
+  After resolving the value for a field, it is completed by ensuring
+  it adheres to the expected return type. If the return type is
+  another Object type, then the field execution process continues
+  recursively."
+  [{:keys [selection-set name type required] :as field} {:keys [schema] :as state} result]
+  (when (and required (nil? result))))
+
+(defn- execute-field
+  "Implement 6.4 Executing Field
+
+  Each field requested in the grouped field set that is defined on the
+  selected objectType will result in an entry in the response
+  map. Field execution first coerces any provided argument values,
+  then resolves a value for the field, and finally completes that
+  value either by recursively executing another selection set or
+  coercing a scalar value."
+  [parent-type-name parent-value fields field-type state]
+  (let [field (first fields)
+        args nil ; FIXME
+        resolved-value (resolve-field-value field state parent-type-name parent-value)]
+    (complete-value field state resolved-value)))

 (defn- execute-fields
   "Implements the 'Executing selection sets' section of the spec for 'read' mode."
-  [fields state parent-type parent-value]
+  [fields state parent-type-name parent-value]
   (reduce (fn execute-fields-field [result-map [response-key response-fields]]
             (prn "execute-fields-field:" response-key)
-            (prn "parent-type:" parent-type)
-            (let [parent-type-name (:name parent-type)
-                  field-name (:name (first response-fields))
+            (prn "parent-type-name:" parent-type-name)
+            (let [field-name (:name (first response-fields))
                   schema (:schema state)
                   field-type (get-field-type schema parent-type-name field-name)
-                  response-value (execute-field parent-type parent-value fields field-type state)]
+                  response-value (execute-field parent-type-name parent-value fields field-type state)]
               (assoc result-map response-key response-value)))
           {}
           fields))
@@ -79,11 +117,12 @@

 (defn- get-operation-root-type
   "Extracts the root type of the operation from the schema."
-  [{:keys [tag] :as operation} {:keys [scheam] :as state}]
+  [{:keys [tag] :as operation} {:keys [schema] :as state}]
+  (prn "schema:" schema)
   (case tag
-    :query-definition (get-in scheam [:roots :query])
-    :selection-set (get-in scheam [:roots :query])
-    :mutation (get-in scheam [:roots :mutation])
+    :query-definition (get-in schema [:roots :query])
+    :selection-set (get-in schema [:roots :query])
+    :mutation (get-in schema [:roots :mutation])
     {:errors [{:message "Can only execute queries, mutations and subscriptions"}]}))

 (defn- execute-operation
@@ -92,6 +131,7 @@
         root-type (get-operation-root-type operation state)
         fields (collect-fields root-type selection-set {} state)]
     (prn "execute-operation: root-type:" root-type)
+    (assert root-type "root-type is nil!")
     (if (seq (:errors validation-result))
       {:errors (:errors validation-result)}
       (case tag


Add table horizontal scroll bar and hide it when a submission is clicked

--- src/hatti/views/dataview.cljs
+++ src/hatti/views/dataview.cljs
@@ -190,7 +190,15 @@
           (for [{:keys [component view]} dataviews
                 :let [view-name (name view)]]
             [:div {:class (str "tab-page " view-name "-page")
-                   :style {:display (view->display view)}}
+                   :style {:height
+                           (:table-view-height (-> app-state :table-page))
+                           :display
+                           (view->display view)
+                           :overflow-x
+                           (if (:prevent-scrolling-in-table-view?
+                                (-> app-state :table-page))
+                             "hidden"
+                             "scroll")}}
              (when (= selected view)
                (send-event :Dataview (str view-name "-page-load"))
                [:div.tab-content {:id (str "tab-content" view-name)}


Refactor: Convert keyword to a string name

--- src/midje/emission/colorize.clj
+++ src/midje/emission/colorize.clj
@@ -10,7 +10,9 @@
   (config/choice :colorize))

 (defn- colorize-config-as-str []
-  (let [setting-as-str (str (colorize-setting))]
+  (let [setting (colorize-setting)
+        setting (if (keyword? setting) (name setting) setting)
+        setting-as-str (str setting)]
     (when-not (str/blank? setting-as-str) setting-as-str)))

 (defn- colorize-choice []
@@ -25,7 +27,7 @@
              (def pass color/green)
              (def note color/cyan))

-    ("REVERSE" ":REVERSE") (do
+    "REVERSE" (do
                 (def fail color/red-bg)
                 (def pass color/green-bg)
                 (def note color/cyan-bg))


db/datastore.clj: removed file (replaced by data.clj)

--- src/org/altlaw/db/datastore.clj
+++ src/org/altlaw/db/datastore.clj
@@ -1,25 +0,0 @@
-(ns org.altlaw.db.datastore
-  (:require [org.altlaw.util.s3 :as s3]))
-
-(def *bucket* "content.altlaw.org")
-
-(defn make-path [path]
-  (str "datastore/" path))
-
-(def get-data
-     (memoize (fn [path]
-                (ref
-                 (read-string
-                  (s3/get-object-string
-                   *bucket* (make-path path)))))))
-
-(defn save-data [path]
-  (let [ref (get-data path)]
-    (s3/put-object-gzip-string
-     *bucket* (make-path path)
-     (pr-str @ref) {"Content-Type" "application/clojure"})))
-
-(defn create-data [path]
-  (s3/put-object-gzip-string
-   *bucket* (make-path path)
-   "nil" {"Content-Type" "application/clojure"}))


util/context.clj: added www-content-dir and www-public-dir

--- src/org/altlaw/util/context.clj
+++ src/org/altlaw/util/context.clj
@@ -32,3 +32,8 @@
    :subname (java.io.File. (str (altlaw-home) "/var/db/" (altlaw-env)))
    :create true})

+(defn www-content-dir []
+  (java.io.File. (str (altlaw-home) "/src/org/altlaw/www/content")))
+
+(defn www-public-dir []
+  (java.io.File. (str (altlaw-home) "/var/public")))


util/context.clj: Get AWS keys from Hadoop config if available

--- src/org/altlaw/util/context.clj
+++ src/org/altlaw/util/context.clj
@@ -45,7 +45,11 @@
   (java.io.File. (str (altlaw-home) "/var/solr")))

 (defn aws-access-key-id []
-  (get-property "org.altlaw.aws.access.key.id"))
+  (or (get-property-function "org.altlaw.aws.access.key.id")
+      (get-property-function "fs.s3.awsAccessKeyId")
+      (throw (Exception. "No AWS Access Key ID (tried org.altlaw.aws.access.key.id and fs.s3.awsAccessKeyID)"))))

 (defn aws-secret-access-key []
-  (get-property "org.altlaw.aws.secret.access.key"))
+  (or (get-property-function "org.altlaw.aws.secret.access.key")
+      (get-property-function "fs.s3.awsSecretAccessKey")
+      (throw (Exception. "No AWS Secret Access Key (tried org.altlaw.aws.secret.access.key and fs.s3.awsSecretAccessKey)"))))


bugfix TripleGraph remove-vertex! (now also removes vertex from backing graph), add triple-logger, update test sketch

--- src/thi/ng/fabric/triples.cljc
+++ src/thi/ng/fabric/triples.cljc
@@ -5,6 +5,7 @@
   (:require
    [thi.ng.fabric.core :as f]
    [clojure.set :as set]
+   [clojure.core.async :as a :refer [go go-loop chan close! <! >! alts! timeout]]
    #?(:clj [taoensso.timbre :refer [debug info warn]])))

 (defprotocol ITripleGraph
@@ -255,6 +256,7 @@
         (f/add-edge! g v obj  signal-triple :remove)
         (f/signal! v)
         (swap! triples dissoc t)
+        (f/remove-vertex! g v)
         v)
       (warn "attempting to remove unknown triple:" t)))
   (add-query!
@@ -314,9 +316,26 @@

 #?(:clj (taoensso.timbre/set-level! :warn))

+(defn triple-logger
+  [path]
+  (let [ch (->> (comp
+                 (filter
+                  (fn [[op id val]]
+                    (and (#{:add-vertex :remove-vertex} op) (vector? val))))
+                 (map
+                  (fn [[op _ t]] [({:add-vertex :+ :remove-vertex :-} op) t])))
+                (chan 1024))]
+    (go-loop []
+      (let [t (<! ch)]
+        (when t
+          (spit path (str (pr-str t) "\n") :append true)
+          (recur))))
+    ch))
+
 (defn start
   []
-  (let [g (triple-graph (f/compute-graph))
+  (let [log (triple-logger "triple-log.edn")
+        g (triple-graph (f/logged-compute-graph (f/compute-graph) log))
         toxi (:result (add-query! g :toxi ['toxi nil nil]))
         types (:result (add-query! g :types [nil 'type nil]))
         projects (:result (add-query! g :projects [nil 'type 'project]))


첫 HTML 변환작업

첫 HTML 변환작업

--- src/인스타파스/변환.clj
+++ src/인스타파스/변환.clj
@@ -8,7 +8,32 @@
 (defn 마크다운 [텍스트]
   (->> 텍스트
        블럭/분석
-       (insta/transform {:문장 (fn [& 내용]
-                                 (문장/분석 (apply str 내용)))})))
+       (insta/transform {:문장 (fn [& 글자들]
+                                 (문장/분석 (apply str 글자들)))})))

 (마크다운 "*강조*큰제목\n====\n일반문장.\n")
+
+(defn ->HTML [트리]
+  (let [태그 (fn [키워드] (case 키워드
+                         :문서   ["" ""]
+                         :큰제목 ["
"   "
"]
+                         :문단   ["
"  "
"]
+                         :문장   [""       ""]
+                         :기울임 [""    ""]
+                         [(name 키워드)]))]
+    (if (seq 트리)
+      (cond
+        (vector? 트리)
+        (let [[열기 닫기] (태그 (first 트리))]
+          (str 열기
+               (apply str (map ->HTML (rest 트리)))
+               닫기))
+
+        (string? 트리)
+        트리
+
+        :else
+        (throw (IllegalStateException.))))))
+
+(->HTML (마크다운 ""))
+(->HTML (마크다운 "중간*강조*큰제목\n====\n일반문장.\n"))


Throw error instead of assert false

Throw error instead of assert false

--- src/reagent/impl/component.cljs
+++ src/reagent/impl/component.cljs
@@ -144,7 +144,7 @@
 (defn custom-wrapper [key f]
   (case key
     :getDefaultProps
-    (assert false "getDefaultProps not supported")
+    (throw (js/Error. "getDefaultProps not supported"))

     :getInitialState
     (fn getInitialState []


another hack til queriac allows ';'

another hack til queriac allows ';'

--- src/semtag_web/client/main.cljs
+++ src/semtag_web/client/main.cljs
@@ -175,8 +175,9 @@
   (home)
   (.click ($ :#add_url_button))
   (if-let [input (util/param-value "input")]
-    ; remove hack when not using cmd service that overrides ':'
-    (let [input (-> (clojure.string/replace input #"\.\." ":"))]
+    ; TODO: remove hacks when not using cmd service that overrides ':' and ';'
+    (let [input (-> (clojure.string/replace input #"\.\." ":"))
+          input (-> (clojure.string/replace input #",," ";"))]
       (.text ($ :#add_url_text) (.decodeURI js/window input))
       (.click ($ :#add_url_button)))
     (alert "No input given.")))


Add such-that

Add such-that

--- src/simple_check/generators.clj
+++ src/simple_check/generators.clj
@@ -109,6 +109,14 @@
   (bind (choose 0 (dec (count generators)))
         #(nth generators %)))

+(defn such-that
+  [gen f]
+  (fn [rand-seed size]
+    (let [value (gen rand-seed size)]
+      (if (f value)
+        value
+        (recur rand-seed size)))))
+
 ;; Instances
 ;; ---------------------------------------------------------------------------


spacing

spacing

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -8,6 +8,7 @@
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.)
+
 (ns celestial.api
   (:refer-clojure :exclude [type])
   (:use [compojure.core :only (defroutes context POST GET routes)]


Remove variadic functions, which are slow.

Since these functions are on the fast path, they should be doing actual
arity dispatching, instead of taking varargs and destructuring them.

--- src/cheshire/core.clj
+++ src/cheshire/core.clj
@@ -84,13 +84,15 @@

   The array-coerce-fn is an optional function taking the name of an array field,
   and returning the collection to be used for array values."
-  [^String string & [key-fn array-coerce-fn]]
-  (when string
-    (parse/parse
-     (.createJsonParser ^JsonFactory (or factory/*json-factory*
-                                         factory/json-factory)
-                        (StringReader. string))
-     key-fn nil array-coerce-fn)))
+  ([string] (parse-string string nil nil))
+  ([string key-fn] (parse-string string key-fn nil))
+  ([^String string key-fn array-coerce-fn]
+     (when string
+       (parse/parse
+        (.createJsonParser ^JsonFactory (or factory/*json-factory*
+                                            factory/json-factory)
+                           (StringReader. string))
+        key-fn nil array-coerce-fn))))

 (defn parse-stream
   "Returns the Clojure object corresponding to the given reader, reader must
@@ -101,12 +103,14 @@
   The array-coerce-fn is an optional function taking the name of an array field,
   and returning the collection to be used for array values.
   If laziness is needed, see parsed-seq."
-  [^BufferedReader rdr & [key-fn array-coerce-fn]]
-  (when rdr
-    (parse/parse
-     (.createJsonParser ^JsonFactory (or factory/*json-factory*
-                                         factory/json-factory) rdr)
-     key-fn nil array-coerce-fn)))
+  ([rdr] (parse-stream rdr nil nil))
+  ([rdr key-fn] (parse-stream rdr key-fn nil))
+  ([^BufferedReader rdr key-fn array-coerce-fn]
+     (when rdr
+       (parse/parse
+        (.createJsonParser ^JsonFactory (or factory/*json-factory*
+                                            factory/json-factory) rdr)
+        key-fn nil array-coerce-fn))))

 (defn parse-smile
   "Returns the Clojure object corresponding to the given SMILE-encoded bytes.
@@ -115,12 +119,14 @@

   The array-coerce-fn is an optional function taking the name of an array field,
   and returning the collection to be used for array values."
-  [^bytes bytes & [key-fn array-coerce-fn]]
-  (when bytes
-    (parse/parse
-     (.createJsonParser ^SmileFactory (or factory/*smile-factory*
-                                          factory/smile-factory) bytes)
-     key-fn nil array-coerce-fn)))
+  ([bytes] (parse-smile bytes nil nil))
+  ([bytes key-fn] (parse-smile bytes key-fn nil))
+  ([^bytes bytes key-fn array-coerce-fn]
+     (when bytes
+       (parse/parse
+        (.createJsonParser ^SmileFactory (or factory/*smile-factory*
+                                             factory/smile-factory) bytes)
+        key-fn nil array-coerce-fn))))

 (def ^{:doc "Object used to determine end of lazy parsing attempt."}
   eof (Object.))
@@ -141,12 +147,14 @@
   The array-coerce-fn is an optional function taking the name of an array field,
   and returning the collection to be used for array values.
   If non-laziness is needed, see parse-stream."
-  [^BufferedReader reader & [key-fn array-coerce-fn]]
-  (when reader
-    (parsed-seq* (.createJsonParser ^JsonFactory
-                                    (or factory/*json-factory*
-                                        factory/json-factory) reader)
-                 key-fn array-coerce-fn)))
+  ([reader] (parsed-seq reader nil nil))
+  ([reader key-fn] (parsed-seq reader key-fn nil))
+  ([^BufferedReader reader key-fn array-coerce-fn]
+     (when reader
+       (parsed-seq* (.createJsonParser ^JsonFactory
+                                       (or factory/*json-factory*
+                                           factory/json-factory) reader)
+                    key-fn array-coerce-fn))))

 (defn parsed-smile-seq
   "Returns a lazy seq of Clojure objects corresponding to the SMILE read from
@@ -154,12 +162,14 @@

   The array-coerce-fn is an optional function taking the name of an array field,
   and returning the collection to be used for array values."
-  [^BufferedReader reader & [key-fn array-coerce-fn]]
-  (when reader
-    (parsed-seq* (.createJsonParser ^SmileFactory
-                                    (or factory/*smile-factory*
-                                        factory/smile-factory) reader)
-                 key-fn array-coerce-fn)))
+  ([reader] (parsed-smile-seq reader nil nil))
+  ([reader key-fn] (parsed-smile-seq reader key-fn nil))
+  ([^BufferedReader reader key-fn array-coerce-fn]
+     (when reader
+       (parsed-seq* (.createJsonParser ^SmileFactory
+                                       (or factory/*smile-factory*
+                                           factory/smile-factory) reader)
+                    key-fn array-coerce-fn))))

 ;; aliases for clojure-json users
 (def encode generate-string)


fixes test mrandersoned failure

fixes test mrandersoned failure

- clojure.tools.reader gets inlined by mranderson so can't be resolved

--- test/resources/unused_deps.clj
+++ test/resources/unused_deps.clj
@@ -1,7 +1,6 @@
 (ns resources.unused-deps
   (:require [clojure edn instant
              [string :as str :refer [join]]]
-            [clojure.tools.reader :as r]
             [clojure.test :refer :all])
   (:import java.util.Deque
            java.util.FormattableFlags


Add username rule

Add username rule

--- src/storemi/routes/register.clj
+++ src/storemi/routes/register.clj
@@ -20,6 +20,11 @@

 (defn none [pred col]
   (not (some pred col)))
+
+(defn valid-username [{params :params}]
+  (let [username (:username params) ]
+    (when (re-find #"[^a-zA-Z0-9]" username)
+      {:username "Must contain only alphanumeric characters."})))

 (defn password-matches [{params :params}]
   (let [p1 (:password  params)
@@ -47,6 +52,7 @@
 (def registration-rule
   (one-by-one
     (has-params [:username :password])
+    valid-username
     (combine username-available
              (one-by-one
                password-matches


Add :use-resources to Android project

Add :use-resources to Android project

--- android/project.clj
+++ android/project.clj
@@ -8,7 +8,8 @@
   :source-paths ["src/clojure" "../common/clojure"]
   :java-source-paths ["src/java" "../common/java" "gen"]

-  :dependencies [[org.clojure-android/clojure "1.5.1-jb"]
+  :dependencies [[org.clojure-android/clojure "1.5.1-jb"
+                  :use-resources true]
                  [neko/neko "3.0.0-beta6"]
                  [com.h2database/h2 "1.3.173"]
                  [markdown-clj "0.9.31"]]


core: interpose

core: interpose

--- core/data/core.clj
+++ core/data/core.clj
@@ -2738,6 +2738,13 @@
   ([f] (lazy-seq (cons (f) (repeatedly f))))
   ([n f] (take n (repeatedly f))))

+(defn interpose
+  "Returns a lazy seq of the elements of coll separated by sep.
+  Returns a stateful transducer when no collection is provided."
+  {:added "1.0"}
+  [sep coll]
+  (drop 1 (interleave (repeat sep) coll)))
+
 (defn get-in
   "Returns the value in a nested associative structure,
   where ks is a sequence of keys. Returns nil if the key


leaf pagination working

leaf pagination working

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -201,6 +201,39 @@
   [src-path action-seq]
   (nth action-seq (count src-path)))

+(defn pagination-to-pick
+  "Pick the next page (sort-of)
+   Do not pass in pagination for more than 1 query!!"
+  [url-ds-seq]
+  (utils/sayln url-ds-seq)
+  (first (sort-by :text url-ds-seq)))
+
+(defn pick-next-pagination-candidate
+  "First, we pick the deepest page to paginate from.
+   Then we pick a source page to start off of (sort-of)"
+  ([pagination-candidates]
+     (pick-next-pagination-candidate pagination-candidates
+                                     nil))
+
+  ([pagination-candidates current-src-url]
+     (if current-src-url
+       (pagination-to-pick
+        (filter
+         #(= (-> % :src-url current-src-url))
+         pagination-candidates))
+
+       (let [xpath-to-candidate (reduce
+                                 (fn [acc x]
+                                   (merge-with concat acc {(:src-xpath x)
+                                                           [x]}))
+                                 pagination-candidates)]
+         (first
+          (second
+           (last
+            (sort-by
+             #(-> % first count)
+             xpath-to-candidate))))))))
+
 (defn crawl-model
   "Args:
    entry-point: starting url
@@ -260,35 +293,35 @@
                (do
                  (utils/sayln :reached-leaf)
                  (let [pagination-extracted (if-not (pagination src-xpath)
-                                              []
+                                              nil
                                               (reduce
                                                concat
                                                (map
                                                 (fn [p]
                                                   (try
-                                                    (first
-                                                     (vals
-                                                      (dom/eval-anchor-xpath
-                                                       p
-                                                       (dom/html->xml-doc body)
-                                                       (-> content-q first :url)
-                                                       (clojure.set/union
-                                                        visited
-                                                        (set (map :url content-q))
-                                                        (set (map :url paging-q))
-                                                        (set blacklist)))))
+                                                    (pagination-to-pick
+                                                     (first
+                                                      (vals
+                                                       (dom/eval-anchor-xpath
+                                                        p
+                                                        (dom/html->xml-doc body)
+                                                        (-> content-q first :url)
+                                                        (clojure.set/union
+                                                         visited
+                                                         (set (map :url content-q))
+                                                         (set (map :url paging-q))
+                                                         (set blacklist))))))
                                                     (catch Exception e [])))
-                                                (pagination src-xpath))))
-                       pagination-extracted-hrefs (map :href pagination-extracted)]
-                   (recur {:content-queue (concat
-                                           (map
-                                            (fn [x]
-                                              {:url x
-                                               :src-xpath src-xpath
-                                               :src-url url
-                                               :pagination true})
-                                            pagination-extracted-hrefs)
-                                           (rest content-q))
+                                                (pagination src-xpath))))]
+                   (utils/sayln pagination-extracted)
+                   (recur {:content-queue (if-not (empty? pagination-extracted)
+                                            (cons
+                                             {:url (:href pagination-extracted)
+                                              :src-xpath src-xpath
+                                              :src-url url
+                                              :pagination true}
+                                             (rest content-q))
+                                            (rest content-q))
                            :paging-queue  paging-q}
                           (conj visited (-> content-q first :url))
                           (+ 1 num-leaves)


fixed prepare routine and visited lists

fixed prepare routine and visited lists

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -36,8 +36,8 @@
        (merge-with concat acc {:bodies  (utils/random-take
                                          10
                                          stuff)
-                               :visited (utils/random-take
-                                         10
+                               :visited (map
+                                         :href
                                          hrefs-and-texts)})))
    {}
    xpaths-and-urls))
@@ -134,7 +134,8 @@
                                   new-bodies)
                           (clojure.set/union
                            (set visited)
-                           (set [url]))
+                           (set [url])
+                           (set new-visited))
                           lookahead
                           leaf?
                           extract
@@ -174,7 +175,9 @@
                        (catch NullPointerException e nil))]
                  (do
                    (recur (concat (rest url-queue) new-bodies)
-                          (clojure.set/union visited (set [url]))
+                          (clojure.set/union visited
+                                             (set [url])
+                                             (set new-visited))
                           lookahead
                           leaf?
                           extract
@@ -558,12 +561,12 @@

                   :corpus corpus

-                  :prefix (uri/host (uri/uri url))})
-
-               ;; this is an initial test.
-               ;; I personally prefer performing the
-               ;; leaf test right at the beginning
-               :else
+                  :prefix (uri/host (uri/uri url))}
+
+                 ;; this is an initial test.
+                 ;; I personally prefer performing the
+                 ;; leaf test right at the beginning
+                 :else)
                (do (utils/sayln :continuing-crawl)
                    (let [state-action (extract body
                                                (first url-queue)
@@ -603,7 +606,7 @@
                             new-corpus))))))))

 (defn crawl-random
-    ([entry-point leaf? extract stop?]
+  ([entry-point leaf? extract stop?]
      (crawl-random entry-point 1 leaf? extract stop?))

   ([entry-point lookahead leaf? extract stop?]
@@ -666,11 +669,11 @@
                            :leaf-limit leaf-limit}

                   :model  (frequencies leaf-paths)
-
+
                   :corpus corpus
-
+
                   :prefix (uri/host (uri/uri url))})
-
+
                ;; leaf reached. what do bruh
                (leaf? {:anchor-text anchor-text
                        :src-url     src-url


Performance optimizations for remote solution: it too long to collect response/diff after evolving

--- src/flatgui/focus.clj
+++ src/flatgui/focus.clj
@@ -37,7 +37,6 @@
   ([component dir c-id]
     (let [child-count (count (:children component))
           child-ids (mapv (fn [[k _]] k) (:children component))
-          _ (println " get-in-cycle c-id " c-id "; child-ids " child-ids)
           closed (:closed-focus-root component)
           cycle-keeper (fn [i]
                          (cond
@@ -49,8 +48,8 @@
         (= child-count 0) nil
         (= child-count 1) (nth child-ids 0)
         :else (case dir
-                :next (nth child-ids (cycle-keeper (inc index-of-c)))
-                :prev (nth child-ids (cycle-keeper (dec index-of-c)))
+                :next (nth child-ids (cycle-keeper (inc index-of-c))) ; If cycle-keeper returns nil here then we escalated
+                :prev (nth child-ids (cycle-keeper (dec index-of-c))) ; to the root and root is not a closed cycle
                 :first (nth child-ids 0)
                 :last (nth child-ids (dec child-count))))))
   ([component dir] (get-in-cycle component dir nil)))
@@ -62,10 +61,7 @@
         this-mode (:mode old-focus-state)
         parent-focus-state (get-property [] :focus-state)
         parent-focused-child (:focused-child parent-focus-state)
-        parent-mode (:mode parent-focus-state)
-        ;_ (println "FOCUS EVOLVER CALLED - " (:id component) " -- " reason)
-        ;_ (println " old-focus-state = " old-focus-state)
-        ]
+        parent-mode (:mode parent-focus-state)]
     (cond

       (keyboard/key-event? component)
@@ -83,25 +79,30 @@
         old-focus-state)

       (mouse/mouse-left? component)
-      (if (and (:focusable component) (#{:none :parent-of-focused :throws-focus} this-mode))
+      (cond
+        (and (:focusable component) (#{:none :parent-of-focused :throws-focus} this-mode))
         {:mode :requests-focus
          :focused-child this-focused-child}
-        old-focus-state)
+        (and (:closed-focus-root component) (#{:none :throws-focus :requests-focus} this-mode))
+        {:mode :has-focus
+         :focused-child nil}
+        :else old-focus-state)

       (fgc/parent-reason? reason)
       (case parent-mode
         :has-focus clean-state
         :none clean-state
         :parent-of-focused (if (= parent-focused-child (:id component))
-                             ;; My parent is ready to give me focus. If I have any child requesting focus then I
-                             ;; give focus to it. Otherwise I leave focus with myself. (*1)
-                             ;(if (= child-mode :requests-focus)
-                             ;  (focus-child child-id)
-                             ;  {:mode :has-focus
-                             ;   :focused-child nil})
-                             (if-let [child-id (:id (first (filter
-                                                             #(= :requests-focus (:mode (:focus-state %)))
-                                                             (for [[_ c] (:children component)] c))))]
+                             ;; My parent is ready to give me focus.
+                             ;;   a) If I have any child requesting focus then I give focus to it.
+                             ;;      Otherwise I leave focus with myself. (*1)
+                             ;;   b) If I am acutally not focusable then I pass focus to the first
+                             ;;      child in my cycle
+                             (if-let [child-id (if (:focusable component)
+                                                 (:id (first (filter
+                                                               #(= :requests-focus (:mode (:focus-state %)))
+                                                               (for [[_ c] (:children component)] c))))
+                                                 (get-in-cycle component :first))]
                                (focus-child child-id)
                                {:mode :has-focus
                                 :focused-child nil})


Remove debug

Remove debug

--- src/harland/build.clj
+++ src/harland/build.clj
@@ -9,5 +9,4 @@
       (sh/with-programs [docker]
         (docker "build" "--force-rm=true" t path)))
     (catch Exception e
-      (println "Something blew")
       (println (ex-data e)))))


basic single-register linearizability test

--- src/jepsen/voltdb.clj
+++ src/jepsen/voltdb.clj
@@ -2,16 +2,23 @@
   (:require [jepsen [core       :as jepsen]
                     [db         :as db]
                     [control    :as c :refer [|]]
+                    [checker    :as checker]
                     [client     :as client]
+                    [generator  :as gen]
+                    [nemesis    :as nemesis]
                     [tests      :as tests]]
             [jepsen.os.debian     :as debian]
             [jepsen.control.util  :as cu]
+            [knossos.model :as model]
             [clojure.string :as str]
             [clojure.data.xml :as xml]
             [clojure.tools.logging :refer [info warn]])
-  (:import (org.voltdb.client Client
+  (:import (org.voltdb VoltTable
+                       VoltTableRow)
+           (org.voltdb.client Client
                               ClientConfig
-                              ClientFactory)))
+                              ClientFactory
+                              ClientResponse)))

 (def username "voltdb")
 (def base-dir "/opt/voltdb")
@@ -107,9 +114,60 @@
   [node]
   (-> (doto (ClientConfig. "" "")
         (.setReconnectOnConnectionLoss true))
-      (ClientFactory/createClient)
-      (doto
-        (.createConnection (name node)))))
+        (ClientFactory/createClient)
+        (doto
+          (.createConnection (name node)))))
+
+(defn volt-table->map
+  "Converts a VoltDB table to a data structure like
+
+  {:status status-code
+   :schema [{:column_name VoltType, ...}]
+   :rows [{:k1 v1, :k2 v2}, ...]}"
+  [^VoltTable t]
+  (let [column-count (.getColumnCount t)
+        column-names (loop [i     0
+                            cols  (transient [])]
+                       (if (= i column-count)
+                         (persistent! cols)
+                         (recur (inc i)
+                                (conj! cols (keyword (.getColumnName t i))))))
+        basis        (apply create-struct column-names)
+        column-types (loop [i 0
+                            types (transient [])]
+                       (if (= i column-count)
+                         (persistent! types)
+                         (recur (inc i)
+                                (conj! types (.getColumnType t i)))))
+        row          (doto (.cloneRow t)
+                       (.resetRowPosition))]
+  {:status (.getStatusCode t)
+   :schema (apply struct basis column-types)
+   :rows (loop [rows (transient [])]
+           (if (.advanceRow row)
+             (let [cols (object-array column-count)]
+               (loop [j 0]
+                 (when (< j column-count)
+                   (aset cols j (.get row j (nth column-types j)))
+                   (recur (inc j))))
+               (recur (conj! rows (clojure.lang.PersistentStructMap/construct
+                                    basis
+                                    (seq cols)))))
+             ; Done
+             (persistent! rows)))}))
+
+(defn call!
+  "Call a stored procedure and returns a seq of VoltTable results."
+  [client procedure & args]
+  (let [res (.callProcedure client procedure (into-array Object args))]
+    ; Docs claim callProcedure will throw, but tutorial checks anyway so ???
+    (assert (= (.getStatus res) ClientResponse/SUCCESS))
+    (map volt-table->map (.getResults res))))
+
+(defn ad-hoc!
+  "Run an ad-hoc SQL stored procedure."
+  [client & args]
+  (apply call! client "@AdHoc" args))

 (defn client
   "A single-register client."
@@ -118,35 +176,57 @@
    (let [initialized? (promise)]
      (reify client/Client
        (setup! [_ test node]
-         (c/on node
-               (try
-                 ; Create table
-                 (sql-cmd! "CREATE TABLE registers (
-                           id          INTEGER UNIQUE NOT NULL,
-                           value       INTEGER NOT NULL,
-                           PRIMARY KEY (id)
-                           );
-                           PARTITION TABLE registers ON COLUMN id;")
-                 (info node "table created")
-
-                 (catch RuntimeException e
-                   ; No IF NOT EXISTS clause for table creation
-                   (when-not (re-find #"already exists" (.getMessage e))
-                     (throw e))))
-
-               ; Install stored procedures
-               (when (deliver initialized? true)
-                 (c/upload "procedures/jepsen-procedures.jar"
-                           (str base-dir "/jepsen-procedures.jar"))
-                 (sql-cmd! "load classes jepsen-procedures.jar")
-                 (sql-cmd! "CREATE PROCEDURE FROM CLASS jepsen.procedures.ReadAll")))
-
-         (client (connect node)))
-
-       (invoke! [this test op])
+         (let [conn (connect node)]
+           (c/on node
+                 (when (deliver initialized? true)
+                   ; Create table
+                   (sql-cmd! "CREATE TABLE registers (
+                             id          INTEGER UNIQUE NOT NULL,
+                             value       INTEGER NOT NULL,
+                             PRIMARY KEY (id)
+                             );
+                             PARTITION TABLE registers ON COLUMN id;")
+                   (info node "table created")
+
+                   ; Install stored procedures
+                   (c/upload "procedures/jepsen-procedures.jar"
+                             (str base-dir "/jepsen-procedures.jar"))
+                   (sql-cmd! "load classes jepsen-procedures.jar")
+                   (sql-cmd! "CREATE PROCEDURE FROM CLASS jepsen.procedures.ReadAll")
+                   (call! conn "REGISTERS.upsert" 0 0)))
+
+           (client conn)))
+
+       (invoke! [this test op]
+         (case (:f op)
+           :read   (assoc op
+                          :type :ok
+                          :value (-> conn
+                                     (call! "REGISTERS.select" 0)
+                                     first
+                                     :rows
+                                     first
+                                     :VALUE))
+           :write (do (call! conn "REGISTERS.upsert" 0 (:value op))
+                      (assoc op :type :ok))
+           :cas   (let [[v v'] (:value op)
+                        res (-> conn
+                                (ad-hoc! "UPDATE registers SET value = ?
+                                         WHERE id = ? AND value = ?"
+                                         v' 0 v)
+                                first
+                                :rows
+                                first
+                                :modified_tuples)]
+                    (assert (#{0 1} res))
+                    (assoc op :type (if (zero? res) :fail :ok)))))

        (teardown! [_ test]
          (.close conn))))))
+
+(defn r   [_ _] {:type :invoke, :f :read, :value nil})
+(defn w   [_ _] {:type :invoke, :f :write, :value (rand-int 5)})
+(defn cas [_ _] {:type :invoke, :f :cas, :value [(rand-int 5) (rand-int 5)]})

 (defn voltdb-test
   "Takes a tarball URL"
@@ -155,4 +235,16 @@
          :name    "voltdb"
          :os      debian/os
          :client  (client)
-         :db      (db url)))
+         :db      (db url)
+         :model   (model/cas-register 0)
+         :checker (checker/compose {:linear checker/linearizable
+                                    :perf   (checker/perf)})
+         :nemesis (nemesis/partition-random-halves)
+         :generator (->> (gen/mix [r w cas])
+                         (gen/stagger 1)
+                         (gen/nemesis
+                           (gen/seq (cycle [(gen/sleep 30)
+                                            {:type :info :f :start}
+                                            (gen/sleep 30)
+                                            {:type :info :f :stop}])))
+                         (gen/time-limit 200))))


Draw notes as whole pixel widths

Draw notes as whole pixel widths

--- src/musicbox/one.cljs
+++ src/musicbox/one.cljs
@@ -32,7 +32,7 @@
   (let [{w :w h :h} instrument
         freqs (keys (:piano-keys instrument))
         note-count (count freqs)
-        note-width (/ w note-count)]
+        note-width (.round js/Math (/ w note-count))]
     (.clearRect draw-ctx 0 0 w h)
     (dotimes [n note-count]
       (let [note (first (:notes (get (:piano-keys instrument) (nth freqs n))))


fix sign in button for subdomain team page

--- src/pc/views/team.clj
+++ src/pc/views/team.clj
@@ -46,7 +46,7 @@
        [:h1 "Join your team!"]
        [:h4 (str (h/h (:subdomain req)) "." (profile/hostname))]
        [:div.calls-to-action
-        [:a.google-login {:href (str (url/map->URL
+        [:a#vendor.google-login {:href (str (url/map->URL
                                       {:host (profile/hostname)
                                        :protocol (if (profile/force-ssl?)
                                                    "https"


Improve promise abstraction implementation and its public api.

--- src/promesa/core.cljs
+++ src/promesa/core.cljs
@@ -25,30 +25,28 @@
 (ns promesa.core
   (:refer-clojure :exclude [delay spread some])
   (:require [cats.core :as m]
-            [cats.context :as mctx]
-            [cats.protocols :as cats]
-            [promesa.protocols :as proto]
+            [cats.context :as mc]
+            [cats.protocols :as mp]
+            [promesa.protocols :as p]
             [org.bluebird]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(declare promise-monad)
+(declare promise-context)

 (extend-type js/Promise
-  cats/Context
-  (get-context [_] promise-monad)
-
-  cats/Extract
-  (extract [it]
-    (.value it))
-
-  IDeref
-  (-deref [it]
-    (.value it))
-
-  proto/IPromise
+  mp/Context
+  (-get-context [_] promise-context)
+
+  mp/Extract
+  (-extract [it]
+    (if (.isRejected it)
+      (.cause it)
+      (.value it)))
+
+  p/IPromise
   (-then [it cb]
     (.then it cb))

@@ -62,20 +60,15 @@
                   type)]
        (.catch it type cb))))

-  (-finally [it cb]
-    (.finally it cb))
-
-  proto/IState
+  p/IState
   (-resolved? [it]
     (.isFulfilled it))
+
   (-rejected? [it]
     (.isRejected it))
-  (-pending? [it]
-    (.isPending it))
-  (-value [it]
-    (.value it))
-  (-reason [it]
-    (.reason it)))
+
+  (-done? [it]
+    (not (.isPending it))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Public Api
@@ -106,58 +99,51 @@
 (defn promise?
   "Returns true if `p` is a primise instance."
   [p]
-  (satisfies? proto/IPromise p))
+  (satisfies? p/IPromise p))

 (defn resolved?
   "Returns true if promise `p` is already fulfilled."
   [p]
-  (proto/-resolved? p))
+  (p/-resolved? p))

 (defn fulfilled?
   "Convenience alias for the `resolved?` predicate."
   [p]
-  (proto/-resolved? p))
+  (p/-resolved? p))

 (defn rejected?
   "Returns true if promise `p` is already rejected."
   [p]
-  (proto/-rejected? p))
+  (p/-rejected? p))

 (defn pending?
   "Returns true if promise `p` is stil pending."
   [p]
-  (proto/-pending? p))
+  (not (p/-done? p)))

 (defn done?
   "Returns true if promise `p` is already done."
   [p]
-  (not (proto/-pending? p)))
+  (p/-done? p))

 ;; Chain operations

 (defn then
   "A chain helper for promises."
   [p callback]
-  (proto/-then p callback))
-
-(defn finally
-  "A chain helper that associate handler to the promise
-  that will be called regardless if it is resolved or
-  rejected."
-  [p callback]
-  (proto/-finally p callback))
+  (p/-then p callback))
+
+(defn chain
+  "A variadic chain operation."
+  [p & funcs]
+  (reduce #(then %1 %2) p funcs))

 (defn catch
   "Catch all promise chain helper."
   ([p callback]
-   (proto/-catch p callback))
+   (p/-catch p callback))
   ([p type callback]
-   (proto/-catch p type callback)))
-
-(defn error
-  "Catch operational errors promise chain helper."
-  [p callback]
-  (.error p callback))
+   (p/-catch p type callback)))

 ;; Helpers

@@ -166,7 +152,8 @@
   that is fulfilled  when all the items in the
   array are fulfilled."
   [promises]
-  (.all js/Promise (clj->js promises)))
+  (m/sequence promises))
+  ;; (.all js/Promise (clj->js promises)))

 (defn any
   "Given an array of promises, return a promise
@@ -182,33 +169,11 @@
   [n promises]
   (.some js/Promise (clj->js promises) n))

-(defn spread
-  "A chain helper like `then` but recevies a
-  resolved promises unrolled as parameters."
-  [p callback]
-  (.spread p callback))
-
-(defn value
-  "Get the fulfillment value of this promise.
-  Throws an error if the promise isn't fulfilled."
-  [p]
-  (proto/-value p))
-
-(defn reason
-  "Get the rejection reason of this promise.
-  Throws an error if the promise isn't rejected."
-  [p]
-  (proto/-reason p))
-
 (defn promisify
   "Given a nodejs like function that accepts a callback
   as the last argument and return an other function
   that returns a promise."
   [callable]
-  ;; (.promisify js/Promise callable)
-  ;; Use own implementation because
-  ;; due to strange reasons it not works
-  ;; properly with bluebird implementation.
   (fn [& args]
     (promise (fn [resolve]
                (let [args (-> (vec args)
@@ -238,28 +203,35 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (def ^{:no-doc true}
-  promise-monad
+  promise-context
   (reify
-    cats/Functor
-    (fmap [mn f mv]
+    mp/ContextClass
+    (-get-level [_] mc/+level-default+)
+
+    mp/Functor
+    (-fmap [mn f mv]
       (then mv f))

-    cats/Applicative
-    (pure [_ v]
+    mp/Applicative
+    (-pure [_ v]
       (promise v))

-    (fapply [_ pf pv]
-      (spread (all [pf pv])
-              (fn [f v]
-                (f v))))
-
-    cats/Monad
-    (mreturn [_ v]
+    (-fapply [_ pf pv]
+      (then (all [pf pv])
+            (fn [[f v]]
+              (f v))))
+
+    mp/Semigroup
+    (-mappend [_ mv mv']
+      (p/-then (m/sequence [mv mv'])
+               (fn [[mvv mvv']]
+                 (let [ctx (mp/-get-context mvv)]
+                   (mp/-mappend ctx mvv mvv')))))
+
+    mp/Monad
+    (-mreturn [_ v]
       (promise v))

-    (mbind [mn mv f]
-      (let [ctx mctx/*context*]
-        (then mv (fn [v]
-                    (m/with-monad ctx
-                      (f v))))))))
-
+    (-mbind [mn mv f]
+      (then mv f))))
+


src/riemann/xymon.clj: s/asdf/events->combo/ #MyBad

--- src/riemann/xymon.clj
+++ src/riemann/xymon.clj
@@ -131,7 +131,8 @@
   Returns a lazy sequence of combo messages. Each message is at most
   xymon-max-line long.
   "
-  ([formatter events] (asdf formatter events combo-header combo-header-len))
+  ([formatter events]
+   (events->combo formatter events combo-header combo-header-len))
   ([formatter events message len]
    (if (empty? events)
      (when-not (= len combo-header-len) '(message))
@@ -141,7 +142,7 @@
            events (rest events)]
        (if (< length xymon-max-line)
          (recur formatter events (str message next "\n\n") length)
-         (cons message (lazy-seq (asdf formatter events))))))))
+         (cons message (lazy-seq (events->combo formatter events))))))))

 (defn send-combo
   "


fixed not to bash the transient in place

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -197,29 +197,30 @@
 ;; Compile-time parsing of tags. Accumulates a transient vector
 ;; before returning the persistent vector of INodes (TextNode, FunctionNode)

+(defn add-text-node [template buf rdr]
+  (let [template (if-let [text (not-empty (.toString buf))]
+                   (conj! template (TextNode. text))
+                   template)]
+    (.setLength buf 0)
+    (conj! template (FunctionNode. (parse-tag (read-tag-info rdr) rdr)))))
+
 (defn parse* [input]
   (with-open [rdr (clojure.java.io/reader input)]
-      (let [template (transient [])
-            buf      (StringBuilder.)]
-        (loop [ch (read-char rdr)]
-          (when ch
+      (let [buf      (StringBuilder.)]
+        (loop [template (transient [])
+               ch (read-char rdr)]
+          (if ch
             (if (and (open-tag? ch rdr) (some #{(peek-rdr rdr)} [*tag-second* *filter-open*]))
-              (do
-                ;; We hit a tag so we append the buffer content to the template
-                ;; and empty the buffer, then we proceed to parse the tag
-                (if-let [text (not-empty (.toString buf))]
-                  (conj! template (TextNode. text)))
-                (.setLength buf 0)
-                (conj! template (FunctionNode. (parse-tag (read-tag-info rdr) rdr)))
-                (recur (read-char rdr)))
+              ;; We hit a tag so we append the buffer content to the template
+              ;; and empty the buffer, then we proceed to parse the tag
+              (recur (add-text-node template buf rdr) (read-char rdr))
               (do
                 ;; Default case, here we append the character and
                 ;; read the next char
                 (.append buf ch)
-                (recur (read-char rdr))))))
-        ;; Add the leftover content of the buffer and return the template
-        (conj! template (TextNode. (.toString buf)))
-        (persistent! template))))
+                (recur template (read-char rdr))))
+            ;; Add the leftover content of the buffer and return the template
+            (->> buf (.toString) (TextNode.) (conj! template) persistent!))))))

 ;; Primary compile-time parse routine. Work we don't want happening after
 ;; first template render. Vector output from parse* gets memoized by render-file.


For demo, default to level 4, which is easier

--- src/sojoban/core.cljs
+++ src/sojoban/core.cljs
@@ -97,7 +97,7 @@
    37 :left
    39 :right})

-(def state (atom {:board (yoshio-levels 0)}))
+(def state (atom {:board (yoshio-levels 3)}))

 (defn process-keydown [ev]
   (when-not (:won @state)


Spotify auth globals

Spotify auth globals

--- src/trak/globals.cljs
+++ src/trak/globals.cljs
@@ -1,6 +1,7 @@
 (ns trak.globals
   (:require-macros [trak.config :refer [cljs-env]])
-  (:require [trak.utils :as utils])
+  (:require [trak.utils :as utils]
+            [clojure.string :as str])
   (:import goog.Uri
            goog.Uri.QueryData
            goog.string))
@@ -11,16 +12,25 @@
   (utils/info kws)
   (utils/info (.createFromKeysValues QueryData (map name (keys kws)) (vals kws)))
   (reduce #(.add %1
-                 (.urlEncode string (name (first %2)))
-                 (.urlEncode string (second %2)))
+                 (name (first %2))
+                 (second %2))
           (QueryData.)
           kws)
   )

 (defn spotify-authorization-link [scope]
   (doto (Uri. "https://accounts.spotify.com/authorize")
-    (.setQuery (build-query-params {:response_type "code"
+    (.setQuery (build-query-params {:response_type "token"
                                     :client_id     (cljs-env :spotify-client-id)
                                     :scope         scope
                                     :redirect_uri  (cljs-env :spotify-redirect-url)
                                     :state         (.getRandomString string)}))))
+
+(defn get-spotify-auth-token []
+  (let [fragment (.getFragment (Uri. (.-href (.-location js/document))))
+        fragment (str/split fragment "&")]
+    (reduce (fn [acc part]
+              (let [kw (str/split part "=")]
+                (merge acc {(keyword (first kw)) (second kw)})))
+            {}
+            fragment)))


Take 2 (outside the boundaries, not inside)

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -150,7 +150,7 @@
   (flush-writer [^JsonGenerator jg _] (.flush jg))
   (prefers-strings [_] true))

-(def MSGPACK_INT_MAX (Math/pow 2 63))
+(def MSGPACK_INT_MAX (bigint (Math/pow 2 63)))
 (def MSGPACK_INT_MIN (- 0 MSGPACK_INT_MAX))

 (extend-protocol Emitter
@@ -164,7 +164,7 @@
   (emit-boolean [^Packer p b as-map-key cache] (.write p b))

   (emit-integer [^Packer p i as-map-key cache]
-    (if (or (string? i) (> i MSGPACK_INT_MIN) (< i MSGPACK_INT_MAX))
+    (if (or (string? i) (> i MSGPACK_INT_MAX) (< i MSGPACK_INT_MIN))
       (emit-string p ESC "i" i as-map-key cache)
       (if (instance? clojure.lang.BigInt i)
         (.write p ^BigInteger (biginteger i))


macros added

macros added

--- src/webdriver/api.clj
+++ src/webdriver/api.clj
@@ -85,6 +85,10 @@

 (defmacro with-conn-error [& body]
   `(with-exception ConnectException false
+     ~@body))
+
+(defmacro when-possible [& body]
+  `(with-exception IllegalArgumentException false
      ~@body))

 ;;


todos added

todos added

--- src/webdriver/dsl.clj
+++ src/webdriver/dsl.clj
@@ -230,22 +230,23 @@
 ;; scripts
 ;;

-;; todo naming? js-...
-(defn execute-js [script & args]
+;; todo names? execute inject
+(defn js-execute [script & args]
   (apply api/execute-script *server* *session* script args))

-(defn inject-js [url]
+(defn js-inject-script [url]
   (let [script (str "var s = document.createElement('script');"
                     "s.type = 'text/javascript';"
                     "s.src = arguments[0];"
                     "document.head.appendChild(s);")]
-    (execute-js script url)))
+    (js-execute script url)))

 ;;
 ;; predicates
 ;;

 ;; todo simplify
+;; todo form for []?
 (defn exists? ;; todo one form
   ([]
    (try+
@@ -414,6 +415,8 @@
 ;;      (with-server host# port#
 ;;        (with-process host# port#
 ;;          ~@body))))
+
+;; todo multi-futures

 (defn el-attr [attr]
   (api/get-element-attribute *server* *session* *element* attr))


comments added

comments added

--- src/webdriver/new.clj
+++ src/webdriver/new.clj
@@ -250,6 +250,10 @@
     {:using (:locator @driver) :value q}
     resp
     (-> resp :value :ELEMENT)))
+
+;;
+;; xpath/css finders
+;;

 ;;
 ;; click


Only use js tagged literal in data readers

--- test-resources/data_readers.clj
+++ test-resources/data_readers.clj
@@ -1,4 +1 @@
-{queue cljs.tagged-literals/read-queue
- uuid cljs.tagged-literals/read-uuid
- inst cljs.tagged-literals/read-inst
- js cljs.tagged-literals/read-js}
+{js cljs.tagged-literals/read-js}


Remove unneeded require

Remove unneeded require

--- test/braid/test/fixtures/db.clj
+++ test/braid/test/fixtures/db.clj
@@ -3,7 +3,6 @@
     [mount.core :as mount]
     [braid.server.db :as db]
     [braid.server.conf :as conf]
-    [braid.server.schema]
     [braid.core.modules :as modules]))

 (defn drop-db [t]