Automatically play next song when the previous end.

--- src/cljs_douban/view.cljs
+++ src/cljs_douban/view.cljs
@@ -13,23 +13,33 @@
        ^{:key (channel "channel_id")}
        [:li (channel "name")])]))

-(defn song-player []
+
+(def current-song (atom {}))
+
+(defn song-player-plain []
   "display songs and controls"
-  (let [current-song (atom {})]
-    (fn []
-      [:div#player
-       [:p "title: " (@current-song "title")]
-       [:audio#player-audio
-        {:autoPlay "true"
-         :controls "true"
-         :src (str (@current-song "url"))
-         :on-ended #(go (reset! current-song (<! (model/end-song))))}]
-       [:input {:type "button"
-                :value "Next Song"
-                :on-click #(go (reset! current-song (<! (model/skip-song))))}]
-       [:input {:type "button"
-                :value "Play/Stop"
-                :on-click #(let [player (sel1 :#player-audio)]
-                             (if (.-paused player)
-                               (.play player)
-                               (.pause player)))}]])))
+  (fn []
+    [:div#player
+     [:p "title: " (@current-song "title")]
+     [:audio#player-audio
+      {:autoPlay "true"
+       :controls "true"
+       :src (str (@current-song "url"))}]
+     [:input {:type "button"
+              :value "Next Song"
+              :on-click #(go (reset! current-song (<! (model/skip-song))))}]
+     [:input {:type "button"
+              :value "Play/Stop"
+              :on-click #(let [player (sel1 :#player-audio)]
+                           (if (.-paused player)
+                             (.play player)
+                             (.pause player)))}]]))
+
+;;; react do not support 'onended' event and thus should manually bind it.
+;;; and this is not very 'reagent'-ish
+;;; Also I had to put 'current-song' into global in order to refer to it.
+(def song-player
+  (with-meta song-player-plain
+    {:component-did-mount
+     (fn [this]
+       (dom/listen! (sel1 :#player-audio) :ended #(go (reset! current-song (<! (model/end-song))))))}))


Add more examples

Add more examples

--- src/clojure/cfbt/ch09.clj
+++ src/clojure/cfbt/ch09.clj
@@ -1,4 +1,5 @@
-(ns cfbt.ch09)
+(ns cfbt.ch09
+  (:require [clojure.core.async :refer [timeout]]))

 (future (Thread/sleep 4000)
         (println "I'll print after 4 seconds"))
@@ -115,3 +116,14 @@
 ;; =>  Whisper your way to success.

 ;; Rolling Your Own Queue:: (p202)
+(defmacro wait
+  "Sleep `timeout` seconds before evaluating body"
+  [timeout & body]
+  `(do (Thread/sleep ~timeout) ~@body))
+
+;; (let [saying3 (promise)]
+;;   (future (deliver saying3 (wait 100 "Cheerio!")))
+;;   @(let [saying2 (promise)]
+;;    (future (delivery saying2 (wait 400 "Pip pip!")))
+;;    @(let [saying 1 (promise)]
+;;       (future (deliver saying1 (wait 200 "Ello, gov'na!"))))))


extract sub alignments with bam/slurp

extract sub alignments with bam/slurp

--- src/clojure/cljam/bam.clj
+++ src/clojure/cljam/bam.clj
@@ -12,7 +12,8 @@
            (java.io DataInputStream DataOutputStream IOException)
            (java.nio ByteBuffer ByteOrder)
            (cljam.cigar TextCigarCodec BinaryCigarCodec CigarElement CigarOperator)
-           (cljam.stream BlockCompressedInputStream BlockCompressedOutputStream)))
+           (cljam.stream BlockCompressedInputStream BlockCompressedOutputStream)
+           (cljam.bam SAMSequenceDictionary SAMSequenceRecord BAMFileIndex)))

 (def fixed-block-size 32)

@@ -132,7 +133,8 @@
   (close [this] (.. this reader close)))

 (defn reader [f]
-  (let [rdr (DataInputStream. (BlockCompressedInputStream. (file f)))]
+  (let [data-rdr (DataInputStream. (BlockCompressedInputStream. (file f)))
+        rdr (BlockCompressedInputStream. (file f))]
     (if-not (Arrays/equals (lsb/read-bytes rdr 4) (.getBytes bam-magic))
       (throw (IOException. "Invalid BAM file header")))
     (let [header (sam/parse-header (lsb/read-string rdr (lsb/read-int rdr)))
@@ -236,12 +238,6 @@
       {:qname qname, :flag flag, :rname rname, :pos pos, :mapq  mapq,
        :cigar cigar, :rnext rnext, :pnext pnext, :tlen tlen, :seq seq,
        :qual qual, :options options})))
-
-(defn read-alignments
-  [rdr]
-  (when-not (zero? (.available (.reader rdr)))
-    (cons (read-alignment (.reader rdr) (.refs rdr))
-          (lazy-seq (read-alignments rdr)))))

 (defn- write-tag-value [writer val-type value]
   (condp = val-type
@@ -325,13 +321,78 @@
   (doseq [a alns]
     (write-alignment wrtr a refs)))

+(defn- make-sequence-dicionary
+  [sequences]
+  (new SAMSequenceDictionary
+       (map (fn [s] (new SAMSequenceRecord (:SN s) (:LN s)))
+            sequences)))
+
+(deftype BamIndex [f sequences]
+  java.io.Closeable
+  (close [this] (.. this f close)))
+
+(defn bam-index
+  [f header]
+  (let [bai-f (str f ".bai")]
+    (when-not (.exists (file bai-f))
+      (throw (IOException. "Could not find BAM Index file")))
+    (let [sequences (:SQ header)
+          seq-dict (make-sequence-dicionary sequences)
+          bai (new BAMFileIndex (file bai-f) seq-dict)]
+      (->BamIndex bai sequences))))
+
+(defn- get-sequnce-index
+  [bai chr]
+  (let [sequences (.sequences bai)
+        indexed (map-indexed vector sequences)
+        filtered (filter #(= (:SN (second %)) chr) indexed)]
+    (first (map first filtered))))
+
+(defn get-spans
+  [bai chr start end]
+  (let [seq-index (get-sequnce-index bai chr)
+        span-array (.getSpanOverlapping (.f bai) seq-index start end)
+        spans (partition 2 (.toCoordinateArray span-array))]
+    spans))
+
+(defn- read-to-finish
+  [rdr finish]
+  (when (and (not (zero? (.available (.reader rdr))))
+             (> finish (.getFilePointer (.reader rdr))))
+    (cons (read-alignment (.reader rdr) (.refs rdr))
+          (lazy-seq (read-to-finish rdr finish)))))
+
+(defn read-alignments
+  ([rdr]
+      (when-not (zero? (.available (.reader rdr)))
+        (cons (read-alignment (.reader rdr) (.refs rdr))
+              (lazy-seq (read-alignments rdr)))))
+  ([rdr bai chr start end]
+     (let [spans (get-spans bai chr start end)
+           window (fn [a]
+                    (and (= chr (:rname a))
+                         (<= start (:pos a))
+                         (>= end (:pos a))))
+           candidates (flatten (map (fn [[begin finish]]
+                                      (.seek (.reader rdr) begin)
+                                      (doall (read-to-finish rdr finish))) spans))]
+       (filter window candidates))))
+
 (defn slurp
   "Opens a reader on bam-file and reads all its headers and alignments,
   returning a map about sam records."
-  [f]
-  (with-open [r (reader f)]
-    {:header (read-header r)
-     :alignments (vec (read-alignments r))}))
+  [f & options]
+  (let [{:keys [chr start end] :or {chr nil
+                                    start 0
+                                    end -1}} options]
+    (with-open [r (reader f)]
+      (let [header (read-header r)]
+        (if (nil? chr)
+          {:header header
+           :alignments (vec (read-alignments r))}
+          (with-open [i (bam-index f header)]
+            {:header header
+             :alignments (vec (read-alignments r i chr start end))}))))))

 (defn spit
   "Opposite of slurp-bam. Opens bam-file with writer, writes sam headers and


Changed copyright text in 'product' module.

--- src/clouseau/products.clj
+++ src/clouseau/products.clj
@@ -3,18 +3,18 @@
 ;;;
 ;;;    Copyright (C) 2015 Pavel Tisnovsky <ptisnovs@redhat.com>
 ;;;
-;;; Bytecode synth is free software; you can redistribute it and/or modify
+;;; Clouseau is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 ;;; the Free Software Foundation; either version 2, or (at your option)
 ;;; any later version.
 ;;;
-;;; Bytecode synth is distributed in the hope that it will be useful, but
+;;; Clouseau is distributed in the hope that it will be useful, but
 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;; General Public License for more details.
 ;;;
 ;;; You should have received a copy of the GNU General Public License
-;;; along with Bytecode synth; see the file COPYING.  If not, write to the
+;;; along with Clouseau; see the file COPYING.  If not, write to the
 ;;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 ;;; 02110-1301 USA.
 ;;;


don't throw assertion error

don't throw assertion error

--- src/co/nclk/flax/core.clj
+++ src/co/nclk/flax/core.clj
@@ -129,7 +129,8 @@
       (log :error (str "[" (:runid resolved) "] Failed.")))
     (if (and (not (true? success))
              (or (:throw node) (:throw resolved)))
-      (throw (AssertionError. (assoc-in resolved [:success :value] false)))
+      ;;(throw (AssertionError. (assoc-in resolved [:success :value] false)))
+      (assoc-in resolved [:success :value] false)
       (assoc-in resolved [:success :value] success))))


Remove array-eq

Remove array-eq

--- src/caesium/util.clj
+++ src/caesium/util.clj
@@ -3,17 +3,8 @@

   This ns is not considered public API, and may break without semver
   major version increments."
-  (:require [caesium.byte-bufs :as bb]
-            [byte-streams :as bs])
   (:import (java.util Arrays)
            (org.apache.commons.codec.binary Hex)))
-
-(def array-eq
-  "Compares two byte arrays for equality.
-
-  Inputs will be converted to bytes as required. Please note that this
-  is not constant time!"
-  bs/bytes=)

 (defn unhexify
   [^String s]


add group to exclusions for depot

add group to exclusions for depot

--- src/cake/project.clj
+++ src/cake/project.clj
@@ -7,7 +7,8 @@
         [uncle.core :only [fileset-seq]]
         [clojure.string :only [split join trim-newline]]
         [clojure.java.shell :only [sh]]
-        [useful.map :only [update merge-in into-map]]
+        [useful.utils :only [adjoin]]
+        [useful.map :only [update into-map]]
         [clojure.java.io :only [reader]])
   (:import [java.io File]))

@@ -161,17 +162,21 @@
   (let [[ns-forms [bindings & body]] (split-with (complement vector?) forms)]
     `(project-eval '~ns-forms ~(quote-if even? bindings) '~body)))

-(defn group [project]
-  (if ('#{clojure clojure-contrib} project)
+(defn group [dep]
+  (if ('#{clojure clojure-contrib} dep)
     "org.clojure"
-    (some #(% project) [namespace name])))
+    (some #(% dep) [namespace name])))
+
+(defn add-group [dep]
+  (symbol (group dep) (name dep)))

 (defn dep-map [deps]
   (let [[deps default-opts] (split-with (complement keyword?) deps)]
     (into {}
           (for [[dep version & opts] deps]
-            (let [dep (symbol (group dep) (name dep))]
-              [dep (into-map :version version default-opts opts)])))))
+            [(add-group dep) (-> (adjoin (into-map default-opts) (into-map opts))
+                                 (assoc :version version)
+                                 (update :exclusions (partial map add-group)))]))))

 (defmulti get-version identity)


Preliminary, not-for-prime-time search working with key decompression

--- src/cfpb/qu/data.clj
+++ src/cfpb/qu/data.clj
@@ -98,7 +98,20 @@
               [k v]))]
     (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) group)))

+(defn compress-fields
+  [fields zipfn]
+  (convert-keys fields zipfn))
+
 (defrecord QueryResult [total size data])
+
+(defn compress-find
+  [database collection find-map]
+  (let [zipfn (field-zip-fn database collection)]
+    (-> find-map
+        (update-in [:query] compress-where zipfn)
+        (update-in [:fields] convert-keys zipfn)
+        (update-in [:sort] convert-keys zipfn))
+    ))

 (defn get-find
   "Given a collection and a Mongo find map, return a QueryResult of the form:
@@ -107,18 +120,22 @@
    :data - Seq of maps with the IDs stripped out"
   [database collection find-map]
   (log/info (str "Mongo find: " find-map))
-
-  (with-db (get-db database)
-    (with-open [cursor (doto (coll/find collection (:query find-map) (:fields find-map))
-                         (.limit (:limit find-map 0))
-                         (.skip (:skip find-map 0))
-                         (.sort (conv/to-db-object (:sort find-map))))]
-      (->QueryResult
-       (.count cursor)
-       (.size cursor)
-       (->> cursor
-            (map (fn [x] (conv/from-db-object x true)))
-            strip-id)))))
+  (let [find-map (compress-find database collection find-map)
+        unzipfn (field-unzip-fn database collection)]
+    (log/info "Post-compress Mongo find: " find-map)
+    (with-db (get-db database)
+      (with-open [cursor (doto (coll/find collection (:query find-map) (:fields find-map))
+                           (.limit (:limit find-map 0))
+                           (.skip (:skip find-map 0))
+                           (.sort (conv/to-db-object (:sort find-map))))]
+        (->QueryResult
+         (.count cursor)
+         (.size cursor)
+         (->> cursor
+              (map (fn [x] (-> x
+                               (conv/from-db-object true)
+                               (convert-keys unzipfn))))
+              strip-id))))))

 (defn compress-aggregation
   [database collection aggregation]


Fixed for failing test (Reverted change for debugging write-object)

--- src/clj_git/core.clj
+++ src/clj_git/core.clj
@@ -85,7 +85,7 @@
         (with-open [wrtr (output-stream filepath)]
           (.write wrtr bdata))
         (unset-writable filepath)))
-    filepath))
+    hash-text))

 (defn write-blob [text]
   (write-object (str "blob " (count text) "\0" text)))


Add dom#replace!

Add dom#replace!

--- src/cljs/c2/dom.cljs
+++ src/cljs/c2/dom.cljs
@@ -70,6 +70,12 @@

 (defn remove! [el]
   (gdom/removeNode (select el)))
+
+(defn replace! [old new]
+  (let [new (if (dom-element? new)
+              new
+              (build-dom-elem new))]
+    (gdom/replaceNode new (select old))))

 (defn style
   ([el] (throw (js/Error. "TODO: return map of element styles")))


Remove svg namespace from fixed scale function: remnant of testing code

--- src/cljx/c2/svg.cljx
+++ src/cljx/c2/svg.cljx
@@ -29,7 +29,7 @@
 (defn scale [coordinates]
   (if (number? coordinates)
     (str "scale(" (float coordinates) ")")
-    (let [[x y] (svg/->xy coordinates)]
+    (let [[x y] (->xy coordinates)]
       (str "scale(" (float x) "," (float y) ")"))))

 (defn rotate


Made tag limit for autoconstruction tag ERCs match the default :tag-limit in args.clj.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -476,13 +476,13 @@
                                   (fn [] (lrand-nth [true false]))))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
-                                  (tag-instruction-erc [:integer :boolean :exec :float] 1000)))
+                                  (tag-instruction-erc [:integer :boolean :exec :float] 10000)))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
-                                  (untag-instruction-erc 1000)))
+                                  (untag-instruction-erc 10000)))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
-                                  (tagged-instruction-erc 1000)))
+                                  (tagged-instruction-erc 10000)))
     (dotimes [n (:autoconstructive-integer-rand-enrichment @push-argmap)]
       (swap! push-argmap assoc
              :atom-generators (conj (:atom-generators @push-argmap) 'autoconstructive_integer_rand)))


Allow specification of types for tag enrichment and tags used in autoconstruction

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -173,8 +173,10 @@
           :tag-enrichment 0
           ;; The number of extra copies of tag-related instructions that will be included in
           ;; the atom-generators.
-          ;; Currently just assumes that all types for which tags are currently implemented
-          ;; are present.
+
+          :tag-enrichment-types [:integer :boolean :exec :float :char :string :code]
+          ;; The types for tag-related instructions that will be included in the atom-generators
+          ;; when :tag-enrichment is greater than 0.

           :autoconstructive false
           ;; If true, then :genetic-operator-probabilities will be {:autoconstruction 1.0},
@@ -222,6 +224,10 @@
           ;; The number of extra instances of autoconstructive_boolean_rand to include in
           ;; :atom-generators for autoconstruction. If negative then autoconstructive_boolean_rand
           ;; will not be in :atom-generators at all.
+
+          :autoconstructive-tag-types [:integer :boolean :exec :float :char :string :code]
+          ;; The types for tag-related instructions that will be included in the atom-generators
+          ;; when :autoconstructive is true.

           ;;----------------------------------------
           ;; Epignenetics
@@ -568,7 +574,7 @@
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
                                   (tag-instruction-erc
-                                    [:integer :boolean :exec :float :char :string :code] 10000)))
+                                    (:autoconstructive-tag-types @push-armap) 10000)))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
                                   (untag-instruction-erc 10000)))
@@ -593,21 +599,22 @@
     (swap! push-argmap assoc
            :replace-child-that-exceeds-size-limit-with :empty))
   (when (> (:tag-enrichment @push-argmap) 0)
-    (swap! push-argmap assoc
-           :atom-generators
-           (let [tag-instructions [(tag-instruction-erc
-                                     [:integer :boolean :exec :float
-                                      :char :string :code] 10000)
-                                   (untag-instruction-erc 10000)
-                                   (tagged-instruction-erc 10000)
-                                   'integer_tagged_instruction
-                                   'integer_tag_exec_instruction
-                                   'integer_tag_code_instruction
-                                   'integer_tag_integer_instruction
-                                   'integer_tag_float_instruction
-                                   'integer_tag_boolean_instruction
-                                   'integer_tag_char_instruction
-                                   'integer_tag_string_instruction]]
+    (let [types (:tag-enrichment-types @push-argmap)
+          use-type #(some #{%} types_)]
+      (swap! push-argmap assoc
+             :atom-generators
+             (let [tag-instructions
+                   (concat [(tag-instruction-erc types 10000)
+                            (untag-instruction-erc 10000)
+                            (tagged-instruction-erc 10000)
+                            'integer_tagged_instruction]
+                           (if (use-type :integer) '[integer_tag_exec_instruction] [])
+                           (if (use-type :code) '[integer_tag_code_instruction] [])
+                           (if (use-type :integer) '[integer_tag_integer_instruction] [])
+                           (if (use-type :float) '[integer_tag_float_instruction] [])
+                           (if (use-type :boolean) '[integer_tag_boolean_instruction] [])
+                           (if (use-type :char) '[integer_tag_char_instruction] [])
+                           (if (use-type :string) '[integer_tag_string_instruction] []))]
              (into (:atom-generators @push-argmap)
                    (take (* (:tag-enrichment @push-argmap) (count tag-instructions))
                          (cycle tag-instructions)))))))


Do some more primitive math

Do some more primitive math

--- src/flatland/useful/io.clj
+++ src/flatland/useful/io.clj
@@ -53,11 +53,19 @@
 (defn compare-bytes [^"[B" a ^"[B" b]
   (let [alen (alength a)
         blen (alength b)
-        len (min alen blen)]
-    (loop [idx 0]
+        len (int (min alen blen))]
+    (loop [idx (int 0)]
       (if (= idx len)
         (compare alen blen)
-        (let [diff (unchecked-byte (unchecked-subtract (aget a idx) (aget b idx)))]
+        (let [ai (long (aget a idx))
+              bi (long (aget b idx))
+              diff (if (neg? ai)
+                     (if (neg? bi)
+                       (unchecked-subtract bi ai)
+                       1)
+                     (if (neg? bi)
+                       -1
+                       (unchecked-subtract ai bi)))]
           (if (zero? diff)
             (recur (unchecked-inc-int idx))
             diff))))))


Clean up the connection back-reference redundancy [IMMUTANT-590]

--- transactions/src/immutant/transactions/jdbc.clj
+++ transactions/src/immutant/transactions/jdbc.clj
@@ -22,17 +22,21 @@
 (defmacro ^:private override-delegate
   [type delegate-expr & body]
   (let [delegate (gensym)
-        overrides (group-by first body)
+        expanded (map macroexpand body)
+        overrides (group-by first expanded)
         methods (for [m (.getMethods (resolve type))
                       :let [f (-> (.getName m) symbol (with-meta {:tag (-> m .getReturnType .getName)}))]
                       :when (not (overrides f))
                       :let [args (for [t (.getParameterTypes m)] (with-meta (gensym) {:tag (.getName t)}))]]
                   (list f (vec (conj args '_)) `(. ~delegate ~f ~@(map #(with-meta % nil) args))))]
     `(let [~delegate ~delegate-expr]
-       (reify ~type ~@body ~@methods))))
+       (reify ~type ~@expanded ~@methods))))

-(defmacro connection-backref
-  "TODO: make this work"
+(defmacro with-backref
+  "Expands to a reify spec for a Connection with an override-delegate
+  call for a Statement, its specific type taken from (:tag (meta f)),
+  created by invoking f on con, that overrides getConnection to return
+  this, the reified Connection"
   [con f args]
   (list f (vec (cons 'this args))
     (list 'override-delegate (:tag (meta f)) `(. ~con ~f ~@(map #(with-meta % nil) args))
@@ -50,48 +54,22 @@

    ;; Ensure each statement's connection back-reference points to this

-   (^Statement createStatement [this]
-     (override-delegate Statement (.createStatement con)
-       (getConnection [_] this)))
-   (^Statement createStatement [this ^int a ^int b]
-     (override-delegate Statement (.createStatement con a b)
-       (getConnection [_] this)))
-   (^Statement createStatement [this ^int a ^int b ^int c]
-     (override-delegate Statement (.createStatement con a b c)
-       (getConnection [_] this)))
+   (with-backref con ^Statement createStatement [])
+   (with-backref con ^Statement createStatement [^int a ^int b])
+   (with-backref con ^Statement createStatement [^int a ^int b ^int c])

-   (^CallableStatement prepareCall [this ^String a]
-     (override-delegate CallableStatement (.prepareCall con a)
-       (getConnection [_] this)))
-   (^CallableStatement prepareCall [this ^String a ^int b ^int c]
-     (override-delegate CallableStatement (.prepareCall con a b c)
-       (getConnection [_] this)))
-   (^CallableStatement prepareCall [this ^String a ^int b ^int c ^int d]
-     (override-delegate CallableStatement (.prepareCall con a b c d)
-       (getConnection [_] this)))
+   (with-backref con ^CallableStatement prepareCall [^String a])
+   (with-backref con ^CallableStatement prepareCall [^String a ^int b ^int c])
+   (with-backref con ^CallableStatement prepareCall [^String a ^int b ^int c ^int d])

-   (^PreparedStatement prepareStatement [this ^String a]
-     (override-delegate PreparedStatement (.prepareStatement con a)
-       (getConnection [_] this)))
-   (^PreparedStatement prepareStatement [this ^String a ^int b]
-     (override-delegate PreparedStatement (.prepareStatement con a b)
-       (getConnection [_] this)))
-   (^PreparedStatement prepareStatement [this ^String a ^ints b]
-     (override-delegate PreparedStatement (.prepareStatement con a b)
-       (getConnection [_] this)))
-   (^PreparedStatement prepareStatement [this ^String a ^"[Ljava.lang.String;" b]
-     (override-delegate PreparedStatement (.prepareStatement con a b)
-       (getConnection [_] this)))
-   (^PreparedStatement prepareStatement [this ^String a ^int b ^int c]
-     (override-delegate PreparedStatement (.prepareStatement con a b c)
-       (getConnection [_] this)))
-   (^PreparedStatement prepareStatement [this ^String a ^int b ^int c ^int d]
-     (override-delegate PreparedStatement (.prepareStatement con a b c d)
-       (getConnection [_] this)))
+   (with-backref con ^PreparedStatement prepareStatement [^String a])
+   (with-backref con ^PreparedStatement prepareStatement [^String a ^int b])
+   (with-backref con ^PreparedStatement prepareStatement [^String a ^ints b])
+   (with-backref con ^PreparedStatement prepareStatement [^String a ^"[Ljava.lang.String;" b])
+   (with-backref con ^PreparedStatement prepareStatement [^String a ^int b ^int c])
+   (with-backref con ^PreparedStatement prepareStatement [^String a ^int b ^int c ^int d])

-   (^DatabaseMetaData getMetaData [this]
-     (override-delegate DatabaseMetaData (.getMetaData con)
-       (getConnection [_] this)))))
+   (with-backref con ^DatabaseMetaData getMetaData [])))

 (defn factory
   "May be passed via the :factory option to a `clojure.java.jdbc` spec


Ready for taxi experiments

Ready for taxi experiments

--- src/exp/experiments.clj
+++ src/exp/experiments.clj
@@ -27,9 +27,9 @@
 (defn make-first-exp-set []
   (experiments/make-experiment-set 'simple-taxi
     [:product
-     [:size [2 5 10] #_[2 5 10 20]]
-     [:npass [1 2 4 8 10] #_[1 2 5 10]]
-     [:alg [:ucs :htn-ucs :sahtn :nsahtn]]]
+     [:size [5 50]#_[2 5 10] #_[2 5 10 20]]
+     [:npass [1 2 4 6 8 10 12 14] #_[1 2 5 10]]
+     [:alg [:ucs :htn-ucs :nsahtn :sahtn]]];
     (fn [m]
       (let [e `(taxi/make-random-taxi-env ~(:size m) ~(:size m) ~(:npass m) 0)]
         (condp = (:alg m)
@@ -45,7 +45,7 @@
         :sahtn    `(sd/sahtn-dijkstra ~'init)
         :nsahtn    `(sd/sahtn-dijkstra ~'init)
         ))
-    'exp.experiments nil 99 512 false  ::ExpResult))
+    'exp.experiments 20 10000 512 false  ::ExpResult))

 (defn pad-right [x n]
   (let [xs (str x)


Page range fixed, changed column resize cursor

--- src/cljs/org/broadinstitute/firecloud_ui/common/table.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/common/table.cljs
@@ -13,6 +13,12 @@

 (def ^:private initial-rows-per-page 10)

+(defn- create-page-range [current-page total-pages]
+  (cond
+    (<= total-pages 5) (range 1 (inc total-pages))
+    (<= current-page 3) (range 1 6)
+    (>= current-page (- total-pages 2)) (range (- total-pages 4) (inc total-pages))
+    :else (range (- current-page 2) (+ current-page 3))))

 (react/defc Paginator
   {:get-current-slice
@@ -28,16 +34,14 @@
            current-page (:current-page @state)
            num-total (:num-rows props)
            num-pages (js/Math.ceil (/ num-total rows-per-page))
-           num-onClick (fn [n] (fn [e] (swap! state assoc :current-page n)))
-           first-page-box (max 1 (- current-page 4))
-           last-page-box (min num-pages (+ current-page 4))
+           num-onClick (fn [n] #(swap! state assoc :current-page n))
+           page-range (create-page-range current-page num-pages)
            allow-prev (> current-page 1)
            allow-next (< current-page num-pages)
            right-num (min num-total (* current-page rows-per-page))
            left-num (if (zero? right-num) 0 (inc (* (dec current-page) rows-per-page)))]
        [:div {:style {:border "1px solid #ebebeb" :boxShadow "-3px -6px 23px -7px #ebebeb inset"}}
-        [:div {:style {:display "block" :fontSize 13 :lineHeight 1.5
-                       :padding "0px 48px" :verticalAlign "middle"}}
+        [:div {:style {:fontSize 13 :lineHeight 1.5 :padding "0px 48px" :verticalAlign "middle"}}

          [:div {:style {:float "left" :display "inline-block" :width "33.33%" :padding "2.15em 0em" :verticalAlign "middle"}}
           [:b {} (str left-num " - " right-num)] (str " of " (pluralize num-total " result"))]
@@ -61,7 +65,7 @@
                                     :cursor (when-not selected? "pointer")}
                             :onClick (when-not selected? (num-onClick n))}
                       n]))
-              (range first-page-box (+ 1 last-page-box)))]
+              page-range)]

            [:div {:style {:display "inline-block" :padding "0.55em 0.9em"
                           :color (if allow-next (:button-blue style/colors) (:border-gray style/colors))
@@ -90,7 +94,7 @@
                        cell-style)}
    (when onResizeMouseDown
      [:div {:style {:position "absolute" :width 20 :top 0 :bottom 0 :left (- width 10) :zIndex 1
-                    :cursor "ew-resize"}
+                    :cursor "col-resize"}
             :onMouseDown onResizeMouseDown}])
    (when onSortClick
      [:div {:style {:position "absolute" :top 0 :bottom 0 :left 0 :width (if onResizeMouseDown (- width 10) width)
@@ -201,7 +205,7 @@
         [:div {:style {:overflowX "auto"}}
          [:div {:style {:position "relative"
                         :minWidth (reduce + (:column-widths @state))
-                        :cursor (when (:dragging? @state) "ew-resize")}
+                        :cursor (when (:dragging? @state) "col-resize")}
                 :onMouseMove (fn [e]
                                (when (:dragging? @state)
                                  (let [widths (:column-widths @state)


Add support for remote repositories via SPARQL & Sesame HTTP API.

--- src/grafter/rdf/sesame.clj
+++ src/grafter/rdf/sesame.clj
@@ -12,6 +12,8 @@
    [org.openrdf.repository Repository RepositoryConnection]
    [org.openrdf.query.resultio TupleQueryResultFormat]
    [org.openrdf.repository.sail SailRepository]
+   [org.openrdf.repository.http HTTPRepository]
+   [org.openrdf.repository.sparql SPARQLRepository]
    [org.openrdf.sail.memory MemoryStore]
    [org.openrdf.rio Rio RDFWriter RDFHandler]
    [org.openrdf.rio.binary BinaryRDFParserFactory]
@@ -325,6 +327,15 @@
      (native-store (io/file datadir) "spoc,posc,cosp"))
   ([datadir indexes]
      (NativeStore. datadir indexes)))
+
+(defn http-repo [repo-url]
+  (HTTPRepository. repo-url))
+
+(defn sparql-repo
+  ([query-url]
+     (SPARQLRepository. query-url))
+  ([query-url update-url]
+     (SPARQLRepository. query-url update-url)))

 (defn repo
   ([] (repo (MemoryStore.)))


Use /meta.edn so that meta works on artifacts

This change puts the metadata of org.clojure/clojure under the "clojure"
dir, meaning that clients can simply link in that directory and get all
of the related data rather than having to special case the meta file(s).

--- src/grimoire/api/fs.clj
+++ src/grimoire/api/fs.clj
@@ -22,7 +22,7 @@
         parent      (:parent thing)
         p           (io/file (str d "/" (when parent (thing->path parent))))
         e           (case which
-                      (:meta)     ".edn"
+                      (:meta)     "/meta.edn"
                       (:related)  "/related.txt"
                       (:examples) "/examples/"
                       (:notes)    "/extended-docstring.md"


gettig cassandra

gettig cassandra

--- src/desafio/core.clj
+++ src/desafio/core.clj
@@ -1,6 +1,7 @@
 (ns desafio.core
   (:require [clojurewerkz.cassaforte.client :as cas]
             [clojurewerkz.cassaforte.cql :as cql]
+            [clojurewerkz.cassaforte.query :as casq]
             [clojurewerkz.elastisch.rest :as esr]
             [clojurewerkz.elastisch.rest.index :as esi]
             [clojurewerkz.elastisch.query :as q]
@@ -23,6 +24,18 @@
                                   :sync  {:type "boolean" :default false}
                                   :created_at {:type "date" :format "date_hour_minute_second"}}}})

+
+(def ^{:const true} keyspace-name "desafio")
+
+(def ^{:const true} casdefinitions
+  (casq/column-definitions {:id :UUID
+                            :timeline :varchar
+                            :text  :varchar
+                            :created_at :timestamp
+                            :sync :boolean
+                            :primary-key [:id]}))
+
+
 ;; Elasticsearch

 (defn esCreateIndexDesafio [esconn]
@@ -31,18 +44,18 @@
 (defn esDeleteIndexDesafio[esconn]
   (esi/delete esconn index-name))

-(defn putRandomTweets [esconn n]
+(defn esPutRandomTweets [esconn n]
   (if (pos? n)
     (do
       (esd/put esconn index-name index-type (str (UUID/randomUUID)) {:timeline "vvmaciel"
-                                                                     :text (str "texto " n)
+                                                                     :text (str "texto orig es " n)
                                                                      :sync false})
       (recur esconn (dec n)))))

-(defn countTweets [esconn]
+(defn esCountTweets [esconn]
   (:count (esd/count esconn index-name index-type)))

-(defn deleteAllTweets[esconn]
+(defn esDeleteAllTweets[esconn]
   (esd/delete-by-query esconn index-name index-type (q/match-all)))

 (defn fetch-scroll-results [conn scroll-id results]
@@ -52,7 +65,7 @@
       (recur conn (:_scroll_id scroll-response) (concat results hits))
       (concat results hits))))

-(defn getNotSyncTweets [esconn]
+(defn esGetNotSyncTweets [esconn]
   (let [response     (esd/search esconn index-name index-type
                                  :query (q/term :sync false)
                                  :search_type "query_then_fetch"
@@ -63,19 +76,73 @@
         all-hits     (fetch-scroll-results esconn scroll-id initial-hits)]
     all-hits))

+(defn es2cas [esconn casconn hits]
+  (if (empty? hits)
+    nil
+    (let [hit (first hits)]
+      ;;process hit
+      (println hit)
+      (recur esconn casconn (rest hits)))))
+
+
+(defn elasticsearch2cassandra [esconn casconn]
+  (let [hits (esGetNotSyncTweets esconn)]
+    (es2cas esconn casconn hits)))

-(defn elasticsearch2cassandra [esconn casconn]
-  (let [hits (getNotSyncTweets esconn)]
-    (es2cas esconn casconn hits)))
 ;; Cassandra
+(defn casCreateKeyspaceDesafio [casconn]
+  (cql/create-keyspace  casconn
+                        keyspace-name
+                        (casq/with {:replication
+                                    {:class "SimpleStrategy"
+                                     :replication_factor 2 }})))
+
+(defn casCreateTableTweet [casconn]
+  (cql/use-keyspace casconn keyspace-name)
+  (cql/create-table casconn "tweet" casdefinitions)
+  (cql/create-index casconn "tweet" "sync")
+  (cql/create-index casconn "tweet" "created_at"))
+
+(defn casDropTableTweet [casconn]
+  (cql/use-keyspace casconn keyspace-name)
+  (cql/drop-table casconn "tweet"))

+(defn casDeleteKeyspaceDesafio [casconn]
+  (cql/drop-keyspace casconn keyspace-name))
+
+
+(defn casPutRandomTweets [casconn n]
+  (if (pos? n)
+    (do
+      (cql/insert casconn "tweet" {:timeline "vvmaciel"
+                                   :text (str "texto orig cas" n)
+                                   :sync false :id (UUID/randomUUID)
+                                   :created_at (.getTime (java.util.Date.))})
+      (recur casconn (dec n)))))
+
+(defn casGetNotSyncTweets [casconn]
+  (cql/select casconn "tweet" (casq/where {:sync false})))
+
+(defn cas2es [esconn casconn hits]
+  (if (empty? hits)
+    nil
+    (let [hit (first hits)]
+      ;;process hit
+      (println hit)
+      (recur esconn casconn (rest hits)))))
+
+(defn cassandra2elasticsearch [esconn casconn]
+  (let [hits (casGetNotSyncTweets casconn)]
+    (cas2es esconn casconn hits)))

 ;; Enable command-line invocation
 (defn -main [& args]
   (let [esconn (esr/connect "http://127.0.0.1:9200")
-        casconn (cas/connect ["127.0.0.1"])]
-    (println "Alo Desafio")))
+        casconn (cas/connect ["127.0.0.1"])]
+    (cql/use-keyspace casconn keyspace-name)
+    (cassandra2elasticsearch esconn casconn)
+    (elasticsearch2cassandra esconn casconn)))


Add more docstrings for constants

Add more docstrings for constants

--- src/hangul_utils/core.clj
+++ src/hangul_utils/core.clj
@@ -7,23 +7,29 @@
 ;; following equation:

 (defn korean-syllable?
+  "Checks whether a given char lies within the Unicode codepoint range for
+  Korean."
   [c]
   (<= 0xAC00 (int c) 0xD7A3))

 (def ^:private initial-jaeums
+  "The jaeums (consonants) which begin Korean characters in modern usage."
   [\ㄱ \ㄲ \ㄴ \ㄷ \ㄸ \ㄹ \ㅁ \ㅂ \ㅃ \ㅅ \ㅆ \ㅇ \ㅈ \ㅉ \ㅊ \ㅋ \ㅌ \ㅍ \ㅎ])
+
+(def ^:private medial-moeums
+  "The moeums (vowels) which begin Korean characters in modern usage."
+  [\ㅏ \ㅐ \ㅑ \ㅒ \ㅓ \ㅔ \ㅕ \ㅖ \ㅗ \ㅘ \ㅙ \ㅚ \ㅛ \ㅜ \ㅝ \ㅞ \ㅟ \ㅠ \ㅡ
+   \ㅢ \ㅣ])
+
+(def ^:private final-jaeums
+  "The jaeums (consonants) which end Korean characters in modern usage. `nil` is
+  included for the characters only made up of two jamo."
+  [nil \ㄱ \ㄲ \ㄳ \ㄴ \ㄵ \ㄶ \ㄷ \ㄹ \ㄺ \ㄻ \ㄼ \ㄽ \ㄾ \ㄿ \ㅀ \ㅁ \ㅂ \ㅄ
+   \ㅅ \ㅆ \ㅇ \ㅈ \ㅊ \ㅋ \ㅌ \ㅍ \ㅎ])

 (def ^:private initial? (set initial-jaeums))

-(def ^:private medial-moeums
-  [\ㅏ \ㅐ \ㅑ \ㅒ \ㅓ \ㅔ \ㅕ \ㅖ \ㅗ \ㅘ \ㅙ \ㅚ \ㅛ \ㅜ \ㅝ \ㅞ \ㅟ \ㅠ \ㅡ
-   \ㅢ \ㅣ])
-
 (def ^:private medial? (set medial-moeums))
-
-(def ^:private final-jaeums
-  [nil \ㄱ \ㄲ \ㄳ \ㄴ \ㄵ \ㄶ \ㄷ \ㄹ \ㄺ \ㄻ \ㄼ \ㄽ \ㄾ \ㄿ \ㅀ \ㅁ \ㅂ \ㅄ
-   \ㅅ \ㅆ \ㅇ \ㅈ \ㅊ \ㅋ \ㅌ \ㅍ \ㅎ])

 (def ^:private final? (set final-jaeums))


Move + fix repeated keystream

Move + fix repeated keystream

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -65,6 +65,31 @@
            RuntimeException #"Ciphertext verification failed"
            (ms/open forgery st/secret-key))))))

+(defn repeated-keystream?
+  "Does given scheme repeat the keystream when applied to given
+  plaintexts?
+
+  This compares the XORd ciphertexts to the XORd plaintexts. This will
+  only be the same when the keystream repeats, and should not happen
+  in an NMR scheme, or in a randomized scheme."
+  ([scheme]
+   (let [ptexts [(.getBytes "four score and ")
+                 (.getBytes "seven years ago")]]
+     (repeated-keystream? ptexts scheme)))
+  ([ptexts scheme]
+   (let [shortest (apply min (map alength ptexts))
+         just-ctext (fn [^bytes ptext]
+                      (->> (scheme ptext)
+                           (drop (+ s/noncebytes s/macbytes))
+                           (take shortest)
+                           byte-array))
+         ctexts (map just-ctext ptexts)
+         xord-ptexts (byte-array shortest)
+         xord-ctexts (byte-array shortest)]
+     (apply #'ms/xor! xord-ptexts ptexts)
+     (apply #'ms/xor! xord-ctexts ctexts)
+     (u/array-eq xord-ptexts xord-ctexts))))
+
 (deftest secretbox-pfx-test
   (let [nonce (byte-array (range s/noncebytes))
         ctext (ms/secretbox-pfx st/ptext nonce st/secret-key)]
@@ -105,31 +130,6 @@
     (is (not (u/array-eq (sn k1 m1) (sn k1 m2))))
     (is (not (u/array-eq (sn k1 m1) (sn k2 m1))))))

-(defn repeated-keystream?
-  "Does given scheme repeat the keystream when applied to given
-  plaintexts?
-
-  This compares the XORd ciphertexts to the XORd plaintexts. This will
-  only be the same when the keystream repeats, and should not happen
-  in an NMR scheme, or in a randomized scheme."
-  ([scheme]
-   (let [ptexts [(.getBytes "four score and ")
-                 (.getBytes "seven years ago")]]
-     (repeated-keystream? ptexts scheme)))
-  ([ptexts scheme]
-   (let [just-ctext (fn [^bytes ptext]
-                      (->> (scheme ptext)
-                           (drop s/noncebytes)
-                           (take (alength ptext))
-                           byte-array))
-         ctexts (map just-ctext ptexts)
-         shortest (apply min (map alength ptexts))
-         xord-ptexts (byte-array shortest)
-         xord-ctexts (byte-array shortest)]
-     (apply #'ms/xor! xord-ptexts ptexts)
-     (apply #'ms/xor! xord-ctexts ctexts)
-     (u/array-eq xord-ptexts xord-ctexts))))
-
 (deftest secretbox-nmr-with-implicit-rnd-nonce-test
   (let [ctext (ms/secretbox-nmr st/ptext st/secret-key)]
     (is-valid-magicnonce-ctext? ctext))


do not dynamically load logging provider.

--- src/io/cyanite/config.clj
+++ src/io/cyanite/config.clj
@@ -1,14 +1,14 @@
 (ns io.cyanite.config
   "Yaml config parser, with a poor man's dependency injector"
-  (:require [clj-yaml.core         :refer [parse-string]]
-            [clojure.string        :refer [split]]
-            [clojure.tools.logging :refer [error info debug]]))
+  (:require [clj-yaml.core          :refer [parse-string]]
+            [clojure.string         :refer [split]]
+            [org.spootnik.logconfig :refer [start-logging!]]
+            [clojure.tools.logging  :refer [error info debug]]))

 (def
   ^{:doc "handle logging configuration from the yaml file"}
   default-logging
-  {:use "org.spootnik.logconfig/start-logging!"
-   :pattern "%p [%d] %t - %c - %m%n"
+  {:pattern "%p [%d] %t - %c - %m%n"
    :external false
    :console true
    :files  []
@@ -117,14 +117,16 @@
   (try
     (when-not quiet?
       (println "starting with configuration: " path))
-    (-> (load-path path)
-        (update-in [:logging] (partial merge default-logging))
-        (update-in [:logging] get-instance :logging)
-        (update-in [:store] (partial merge default-store))
-        (update-in [:store] get-instance :store)
-        (update-in [:carbon] (partial merge default-carbon))
-        (update-in [:carbon :rollups] convert-shorthand-rollups)
-        (update-in [:carbon :rollups] assoc-rollup-to)
-        (update-in [:index] (partial merge default-index))
-        (update-in [:index] get-instance :index)
-        (update-in [:http] (partial merge default-http)))))
+    (let [config (load-path path)]
+      (start-logging! (merge default-logging (:logging config)))
+      (-> (load-path path)
+
+          (update-in [:store] (partial merge default-store))
+          (update-in [:store] get-instance :store)
+
+          (update-in [:carbon] (partial merge default-carbon))
+          (update-in [:carbon :rollups] convert-shorthand-rollups)
+          (update-in [:carbon :rollups] assoc-rollup-to)
+          (update-in [:index] (partial merge default-index))
+          (update-in [:index] get-instance :index)
+          (update-in [:http] (partial merge default-http))))))


Add missing map catparam

Add missing map catparam

--- src/io/cyanite/engine.clj
+++ src/io/cyanite/engine.clj
@@ -75,7 +75,7 @@

 (defn snapshot-path
   [now [path resolutions]]
-  (vec (mapcat (partial snapshot-resolution path now))))
+  (vec (mapcat (partial snapshot-resolution path now) resolutions)))

 (defrecord Engine [rules state queues ingestq planner drift reporter]
   component/Lifecycle


Delete scratch space code

Delete scratch space code

--- test/onyx_jepsen/onyx_aggregation_test.clj
+++ test/onyx_jepsen/onyx_aggregation_test.clj
@@ -8,18 +8,6 @@
             [onyx-jepsen.gen :as onyx-gen]
             [jepsen.core :as jc]
             [jepsen.control :as c]))
-
-(comment (def info (:information (:job-invariants (read-string (slurp "/Users/lucas/clojure/onyx-jepsen/store/onyx-aggregation-test/20160125T135056.000Z/results.edn")))))
-
-         (def read-values (set (:read-values info)))
-
-         (def not-triggered (set (:added-not-triggered info)))
-
-         (count read-values)
-         (count (identity not-triggered))
-         (keys info)
-         (count read-values)
-         (count not-triggered))

 (def version
   "What onyx version should we test?"


updated

updated

--- src/hivewing_core/hive.clj
+++ src/hivewing_core/hive.clj
@@ -7,12 +7,19 @@
             [hivewing-core.worker-config :refer [worker-config-set-hive-image]]
             [clojure.java.jdbc :as jdbc]))

+(defn hive-can-read?
+  [bk-uuid hive-uuid]
+  (try
+    (if (and hive-uuid bk-uuid)
+      (jdbc/query sql-db ["SELECT beekeeper_uuid FROM hive_managers WHERE hive_uuid = ? AND beekeeper_uuid = ? LIMIT 1" (ensure-uuid hive-uuid) (ensure-uuid bk-uuid)] :result-set-fn first)
+      nil)
+    (catch clojure.lang.ExceptionInfo e false)))

 (defn hive-can-modify?
   [bk-uuid hive-uuid]
   (try
     (if (and hive-uuid bk-uuid)
-      (jdbc/query sql-db ["SELECT beekeeper_uuid FROM hive_managers WHERE hive_uuid = ? AND beekeeper_uuid = ? LIMIT 1" (ensure-uuid hive-uuid) (ensure-uuid bk-uuid)] :result-set-fn first)
+      (jdbc/query sql-db ["SELECT beekeeper_uuid FROM hive_managers WHERE hive_uuid = ? AND beekeeper_uuid = ? AND can_write = true LIMIT 1" (ensure-uuid hive-uuid) (ensure-uuid bk-uuid)] :result-set-fn first)
       nil)
     (catch clojure.lang.ExceptionInfo e false)))


Update and pull out table protocol methods.

--- src/merkle_db/table.clj
+++ src/merkle_db/table.clj
@@ -471,94 +471,136 @@
         (cons (first records) (patch-seq patch (next records))))))

-(extend-type Table
-
-  ITable
-
-  ;; Records
-
-  (scan
-    [^Table this opts]
-    ; TODO: apply lexicoder
+(defn- table-lexicoder
+  "Construct a lexicoder for the keys in a table."
+  [table]
+  (key/lexicoder (::key/lexicoder table :bytes)))
+
+
+(defn- key-decoder
+  "Return a function which will decode the keys in record entries with the
+  given lexicoder."
+  [lexicoder]
+  (fn [[k r]] [(key/decode lexicoder k) r]))
+
+
+(defn- scan*
+  [^Table table opts]
+  (let [lexicoder (table-lexicoder table)
+        start-key (some->> (:start-key opts) (key/encode lexicoder))
+        end-key (some->> (:end-key opts) (key/encode lexicoder))]
     (->>
       (patch-seq
         ; Merged patch data to apply to the records.
-        (prepare-patch (.patch-data this) opts) ; TODO: merge ::patch
+        (prepare-patch (.patch-data table) opts) ; TODO: merge ::patch
         ; Lazy sequence of matching records from the index tree.
         (when-let [data-node (mdag/get-data
-                               (.store this)
-                               (::data (.node-data this)))]
-          (if (or (:start-key opts) (:end-key opts))
+                               (.store table)
+                               (::data (.root-data table)))]
+          (if (or start-key end-key)
             (index/read-range
-              (.store this)
+              (.store table)
               data-node
               (:fields opts)
-              (:start-key opts)
-              (:end-key opts))
+              start-key
+              end-key)
             (index/read-all
-              (.store this)
+              (.store table)
               data-node
               (:fields opts)))))
-      (remove-tombstones)))
+      (remove-tombstones)
+      (map (key-decoder lexicoder)))))
+
+
+(defn- get-records*
+  [^Table table id-keys opts]
+  (let [lexicoder (table-lexicoder table)
+        id-keys (into #{} (map (partial key/encode lexicoder)) id-keys)
+        patch-map (.patch-data table) ; TODO: merge ::patch
+        patch-entries (select-keys patch-map id-keys)
+        extra-keys (apply disj id-keys (keys patch-entries))
+        patch-entries (cond->> (remove-tombstones patch-entries)
+                        (seq (:fields opts))
+                          (map (fn [[k r]] [k (select-keys r (:fields opts))])))
+        data-entries (when-let [data-node (and (seq extra-keys)
+                                               (mdag/get-data
+                                                 (.store table)
+                                                 (::data (.root-data table))))]
+                       (index/read-batch
+                         (.store table)
+                         data-node
+                         (:fields opts)
+                         extra-keys))]
+    (->> (concat patch-entries data-entries)
+         (map (key-decoder lexicoder)))))
+
+
+(defn- insert*
+  [table records opts]
+  (let [{:keys [merge-record merge-field]} opts
+        lexicoder (table-lexicoder table)
+        update-record (cond
+                        merge-record merge-record
+                        merge-field
+                        (fn merge-fields
+                          [_ old-data new-data]
+                          (reduce
+                            (fn [data field-key]
+                              (assoc data
+                                     field-key
+                                     (merge-field field-key
+                                                  (get old-data field-key)
+                                                  (get new-data field-key))))
+                            {} (distinct (concat (keys old-data) (keys new-data)))))
+                        :else
+                        (fn merge-simple
+                          [_ old-data new-data]
+                          (into {}
+                                (filter (comp some? val))
+                                (merge old-data new-data))))
+        extant (into {} (get-records table (map first records) nil))
+        new-records (map
+                      (fn [[k data]]
+                        [(key/encode lexicoder k)
+                         (update-record k (get extant k) data)])
+                      records)]
+    ; Add new data maps to patch-data.
+    ; TODO: adjust ::data/count based on extant keys
+    (update-patch table into new-records)))
+
+
+(defn- delete*
+  [table id-keys]
+  (let [lexicoder (key/lexicoder (::key/lexicoder table :bytes))]
+    ; TODO: need to look up whether the keys exist;
+    ; don't add tombstones for absent keys, adjust ::data/count
+    (update-patch
+      table into
+      (map (fn [k] [(key/encode lexicoder k) tombstone])
+           id-keys))))
+
+
+(extend-type Table
+
+  ITable
+
+  ;; Records
+
+  (scan
+    [this opts]
+    (scan* this opts))

   (get-records
-    [^Table this id-keys opts]
-    ; TODO: apply lexicoder
-    (let [id-keys (set id-keys)
-          patch-map (.patch-data this) ; TODO: merge ::patch
-          patch-entries (select-keys patch-map id-keys)
-          extra-keys (apply disj id-keys (keys patch-entries))
-          patch-entries (cond->> (remove-tombstones patch-entries)
-                          (seq (:fields opts))
-                            (map (fn [[k r]] [k (select-keys r (:fields opts))])))
-          data-entries (when-let [data-node (and (seq extra-keys)
-                                                 (mdag/get-data
-                                                   (.store this)
-                                                   (::data (.node-data this))))]
-                         (index/read-batch
-                           (.store this)
-                           data-node
-                           (:fields opts)
-                           extra-keys))]
-      (concat patch-entries data-entries)))
+    [this id-keys opts]
+    (get-records* this id-keys opts))

   (insert
     [this records opts]
-    ; TODO: apply lexicoder
-    (let [{:keys [merge-record merge-field]} opts
-          update-record (cond
-                          merge-record merge-record
-                          merge-field
-                          (fn merge-fields
-                            [_ old-data new-data]
-                            (reduce
-                              (fn [data field-key]
-                                (let [])
-                                (assoc data
-                                       field-key
-                                       (merge-field field-key
-                                                    (get old-data field-key)
-                                                    (get new-data field-key))))
-                              {} (distinct (concat (keys old-data) (keys new-data)))))
-                          :else
-                          (fn merge-simple
-                            [_ old-data new-data]
-                            (into {}
-                                  (filter (comp some? val))
-                                  (merge old-data new-data))))
-          extant (into {} (get-records this (map first records) nil))
-          new-records (map
-                        (fn [[k data]]
-                          [k (update-record k (get extant k) data)])
-                        records)]
-      ; Add new data maps to patch-data.
-      (update-patch this into new-records)))
+    (insert* this records opts))

   (delete
     [this id-keys]
-    ; TODO: apply lexicoder
-    ; Add tombstones to patch-data.
-    (update-patch this into (map vector id-keys (repeat tombstone)))))
+    (delete* this id-keys)))


Update dependencies to the latest hoplon...

...boot.task and boot.core

--- build.boot
+++ build.boot
@@ -1,12 +1,11 @@
 #!/usr/bin/env boot

-#tailrecursion.boot.core/version "2.0.0"
+#tailrecursion.boot.core/version "2.3.1"

 (set-env!
-  :dependencies  [['tailrecursion/boot.core   "2.0.0"]
-                  ['tailrecursion/boot.task   "2.0.0"]
-                  ['tailrecursion/hoplon      "5.0.0"]
-                  ['markdown-clj              "0.9.38"]
+  :dependencies  [['tailrecursion/boot.task   "2.1.2"]
+                  ['tailrecursion/hoplon      "5.7.0"]
+                  ['markdown-clj              "0.9.41"]
                   ['org.clojure/clojurescript "0.0-2156"]]
   :src-paths     #{"src"}
   :out-path      "resources/public")


"boot-reload" to 0.4.8

"boot-reload" to 0.4.8

--- build.boot
+++ build.boot
@@ -34,7 +34,7 @@
                   [tolitius/boot-stripper      "0.1.0-SNAPSHOT"  :scope "test"]
                   [com.cemerick/piggieback     "0.2.1"           :scope "test" :exclusions [org.clojure/clojurescript]]
                   [weasel                      "0.7.0"           :scope "test" :exclusions [org.clojure/clojurescript]]
-                  [adzerk/boot-reload          "0.4.2"           :scope "test"]
+                  [adzerk/boot-reload          "0.4.8"           :scope "test"]
                   [crisptrutski/boot-cljs-test "0.2.1-SNAPSHOT"  :scope "test"]])

 (require '[adzerk.bootlaces :refer :all]


Fix resource-paths typo

Fix resource-paths typo

--- build.boot
+++ build.boot
@@ -29,7 +29,7 @@
 (deftask run-tests []
   (merge-env!
     :source-paths ["test/src"]
-    :resoure-paths ["test/resources"])
+    :resource-paths ["test/resources"])
   (boot-test/alt-test))

 (deftask push-release []


RS | #0 | Use wrap-forwarded-scheme to attempt to prevent redirect loop on wrap-ssl-redirect

--- src/objective8/core.clj
+++ src/objective8/core.clj
@@ -8,7 +8,7 @@
             [ring.middleware.flash :refer [wrap-flash]]
             [ring.middleware.json :refer [wrap-json-params wrap-json-response]]
             [ring.middleware.x-headers :refer [wrap-xss-protection wrap-frame-options wrap-content-type-options]]
-            [ring.middleware.ssl :refer  [wrap-ssl-redirect wrap-hsts]]
+            [ring.middleware.ssl :refer [wrap-ssl-redirect wrap-hsts wrap-forwarded-scheme]]
             [bidi.ring :refer [make-handler]]
             [taoensso.tower.ring :refer [wrap-tower]]
             [objective8.routes :as routes]
@@ -102,7 +102,7 @@
       (wrap-xss-protection true {:mode :block})
       (wrap-frame-options :sameorigin)
       ((if (config/get-var "HTTPS_ONLY")
-         wrap-ssl-redirect
+         (comp  wrap-ssl-redirect wrap-forwarded-scheme)
          identity))
       ))


Refactor Filestore Schema

Refactor Filestore Schema

--- src/konserve/filestore.clj
+++ src/konserve/filestore.clj
@@ -4,7 +4,6 @@
             [konserve.core :refer [go-locked]]
             [clojure.java.io :as io]
             [hasch.core :refer [uuid]]
-
             [clojure.core.async :as async
              :refer [<!! <! >! timeout chan alt! go go-loop close! put!]]
             [clojure.edn :as edn]
@@ -16,7 +15,7 @@
   (:import [java.io
             DataInputStream DataOutputStream
             FileInputStream FileOutputStream
-            ByteArrayInputStream]
+            ByteArrayOutputStream ByteArrayInputStream]
            [java.nio.channels FileChannel AsynchronousFileChannel CompletionHandler]
            [java.nio ByteBuffer]
            [java.nio.file Files StandardCopyOption FileSystems Path OpenOption
@@ -24,10 +23,8 @@

 ;; A useful overview over fsync on Linux:
 ;; https://www.usenix.org/conference/osdi14/technical-sessions/presentation/pillai
-
 (defn- on-windows? []
   (>= (.indexOf (.toLowerCase (System/getProperty "os.name")) "win") 0))
-

 (defn- sync-folder [folder]
   (when-not (on-windows?) ;; not necessary (and possible) on windows
@@ -35,7 +32,6 @@
           fc (FileChannel/open p (into-array OpenOption []))]
       (.force fc true)
       (.close fc))))
-

 (defn delete-store
   "Permanently deletes the folder of the store with all files."
@@ -49,13 +45,315 @@
       (catch Exception e
         nil))))

-
 (defn list-keys
+  "Lists all keys in this binary store. This operation *does not block concurrent operations* and might return an outdated key set. Keys of binary blobs are not tracked atm."
+  [{:keys [folder serializer read-handlers ] :as store}]
+  (let [fns (->> (io/file (str folder "/Key"))
+                 .list
+                 seq
+                 (filter #(re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}"
+                                      %))
+                 (map (fn [fn]
+                        (go-locked
+                         store fn
+                         (let [f  (io/file (str folder "/Key/" fn))
+                               fd (io/file (str folder "/Data/" fn))]
+                           (if (and (.exists f) (.exists fd))
+                             (let [fis (DataInputStream. (FileInputStream. f))]
+                               (try
+                                 (-deserialize serializer read-handlers fis)
+                                 (catch Exception e
+                                   (ex-info "Could not read key."
+                                            {:type      :read-error
+                                             :key       fn
+                                             :exception e}))
+                                 (finally
+                                   (.close fis))))
+                             (println "Stale key file detected: " fn))))))
+                 async/merge
+                 (async/into #{}))]
+    fns))
+
+
+
+;; Helper Function for FileSystemStore
+(defn- read-key
+  "help function for -update-in"
+  [folder f fkey serializer read-handlers]
+    (when (.exists f)
+      (let [fis (DataInputStream. (FileInputStream. f))]
+        (try
+          (-deserialize serializer read-handlers fis)
+          (catch Exception e
+            (ex-info "Could not read key."
+                     {:type      :read-error
+                      :key       fkey
+                      :exception e}))
+          (finally
+            (.close fis))))))
+
+(defn- write-edn
+  "help function for -update-in"
+  [serializer write-handlers read-handlers folder key-vec fn up-fn config]
+  (let [[fkey & rkey] key-vec
+        f             (io/file (str folder fn))
+        old           (read-key folder f fkey serializer read-handlers)
+        new-file      (io/file (str folder fn ".new"))
+        fos           (FileOutputStream. new-file)
+        dos           (DataOutputStream. fos)
+        fd            (.getFD fos)
+        value           (if-not (empty? rkey)
+                        (update-in old rkey up-fn)
+                        (up-fn old))]
+    (if (instance? Throwable old)
+      old ;; return read error
+      (try
+        (-serialize serializer dos write-handlers value)
+        (.flush dos)
+        (when (:fsync config)
+          (.sync fd))
+        (.close dos)
+        (Files/move (.toPath new-file) (.toPath f)
+                    (into-array [StandardCopyOption/ATOMIC_MOVE]))
+        (when (:fsync config)
+          (sync-folder folder))
+        [(get-in old rkey)
+         (get-in value rkey)]
+        (catch Exception e
+          (.delete new-file)
+          ;; TODO maybe need fsync new-file here?
+          (throw
+           (ex-info "Could not write key."
+                    {:type      :write-error
+                     :key       fkey
+                     :exception e})))
+        (finally
+          (.close dos))))))
+
+
+(defn- write-edn-key
+  "help function for -update-in"
+  [serializer write-handlers read-handlers folder fn {:keys [key] :as key-meta} config]
+  (let [f             (io/file (str folder fn))
+        new-file      (io/file (str folder fn ".new"))
+        fos           (FileOutputStream. new-file)
+        dos           (DataOutputStream. fos)
+        fd            (.getFD fos)]
+    (try
+      (-serialize serializer dos write-handlers key-meta)
+      (.flush dos)
+      (when (:fsync config)
+        (.sync fd))
+      (.close dos)
+      (Files/move (.toPath new-file) (.toPath f)
+                  (into-array [StandardCopyOption/ATOMIC_MOVE]))
+      (when (:fsync config)
+        (sync-folder folder))
+      (catch Exception e
+        (.delete new-file)
+        ;; TODO maybe need fsync new-file here?
+        (throw
+         (ex-info "Could not write key file."
+                  {:type      :write-key-error
+                   :key       key
+                   :exception e})))
+      (finally
+        (.close dos)))))
+
+(defn- read-memory-entry
+  "Helper Function for -get-in"
+  [f res-ch folder fn fkey rkey serializer read-handlers]
+  (if-not (.exists f)
+    (close! res-ch)
+    (try
+      (let [ac (AsynchronousFileChannel/open (.getPath (FileSystems/getDefault)
+                                                       (str folder "/Data/" fn)
+                                                       (into-array String []))
+                                             (into-array StandardOpenOption
+                                                         [StandardOpenOption/READ]))
+            bb (ByteBuffer/allocate (.size ac))]
+        (.read ac
+               bb
+               0
+               nil
+               (proxy [CompletionHandler] []
+                 (completed [res att]
+                   (let [bais (ByteArrayInputStream. (.array bb))]
+                     (try
+                       (put! res-ch
+                             (-deserialize serializer read-handlers bais))
+                       (catch Exception e
+                         (ex-info "Could not read key."
+                                  {:type      :read-error
+                                   :key       fkey
+                                   :exception e}))
+                       (finally
+                         (.close ac)))))
+                 (failed [t att]
+                   (put! res-ch (ex-info "Could not read key."
+                                         {:type      :read-error
+                                          :key       fkey
+                                          :exception t}))
+                   (.close ac)))))
+      (catch Exception e
+        (put! res-ch (ex-info "Could not read key."
+                              {:type      :read-error
+                               :key       fkey
+                               :exception e}))))))
+
+(defn- delete-entry
+  "Delete Filestore Entry"
+  [fn folder config]
+  (let [file (io/file (str folder "/" fn))]
+    (.delete file)
+    (when (:fsync config)
+      (sync-folder folder))
+    nil))
+
+(defn- binary-read [f res-ch folder fn key locked-cb]
+  (if-not (.exists f)
+    (close! res-ch)
+    (try
+      (let [ac (AsynchronousFileChannel/open (.getPath (FileSystems/getDefault)
+                                                       (str folder "/Data/" fn)
+                                                       (into-array String []))
+                                             (into-array StandardOpenOption
+                                                         [StandardOpenOption/READ]))
+            bb (ByteBuffer/allocate (.size ac))]
+        (.read ac
+               bb
+               0
+               nil
+               (proxy [CompletionHandler] []
+                 (completed [res att]
+                   (let [bais (ByteArrayInputStream. (.array bb))]
+                     (try
+                       (locked-cb {:input-stream bais
+                                   :size         (.length f)
+                                   :file         f})
+                       (catch Exception e
+                         (ex-info "Could not read key."
+                                  {:type      :read-error
+                                   :key       key
+                                   :exception e}))
+                       (finally
+                         (close! res-ch)
+                         (.close ac)))))
+                 (failed [t att]
+                   (put! res-ch (ex-info "Could not read key."
+                                         {:type      :read-error
+                                          :key       key
+                                          :exception t}))
+                   (close! res-ch)
+                   (.close ac)))))
+      (catch Exception e
+        (put! res-ch (ex-info "Could not read key."
+                              {:type      :read-error
+                               :key       key
+                               :exception e}))))))
+
+(defn- write-binary
+  "Helper Function for Binary Write"
+  [folder fn key input config]
+  (let [f        (io/file (str folder "/Data/" fn))
+        new-file (io/file (str folder "/Data/" fn ".new"))
+        fos      (FileOutputStream. new-file)
+        dos      (DataOutputStream. fos)
+        fd       (.getFD fos)]
+    (try
+      (io/copy input dos)
+      (.flush dos)
+      (when (:fsync config)
+        (.sync fd))
+      (.close fos) ;; required for windows
+      (Files/move (.toPath new-file) (.toPath f)
+                  (into-array [StandardCopyOption/ATOMIC_MOVE]))
+      (when (:fsync config)
+        (sync-folder folder))
+      (catch Exception e
+        (.delete new-file)
+        (ex-info "Could not write key."
+                 {:type      :write-error
+                  :key       key
+                  :exception e}))
+      (finally
+        (.close fos)))))
+
+(defrecord FileSystemStore [folder serializer read-handlers write-handlers locks config]
+  PEDNAsyncKeyValueStore
+  (-exists? [this key]
+    (let [fn  (uuid key)
+          f   (io/file (str folder "/Data/" fn))
+          res (chan)]
+      (put! res (.exists f))
+      (close! res)
+      res))
+  ;; non-blocking async version
+  (-get-in [this key-vec]
+    (let [[fkey & rkey] key-vec
+          fn            (uuid fkey)
+          f             (io/file (str folder "/Data/" fn))
+          res-ch        (chan)]
+      (read-memory-entry f res-ch folder fn fkey rkey serializer read-handlers)
+      res-ch))
+  (-update-in [this key-vec up-fn]
+    (async/thread
+      (try
+        (let [file-name   (uuid (first key-vec))
+              data-folder (str folder "/Data/")
+              key-folder  (str folder "/Key/")]
+          (write-edn-key serializer write-handlers read-handlers key-folder file-name {:key (first key-vec) :format :edn} config)
+          (write-edn serializer write-handlers read-handlers data-folder key-vec file-name up-fn config))
+        (catch Exception e
+          e))))
+
+  (-assoc-in [this key-vec val] (-update-in this key-vec (fn [_] val)))
+
+  (-dissoc [this key]
+    (async/thread
+      (let [fn          (uuid key)
+            key-folder  (str folder "/Key")
+            data-folder (str folder "/Data")]
+          (delete-entry fn key-folder config)
+          (delete-entry fn data-folder config))))
+
+  PBinaryAsyncKeyValueStore
+  (-bget [this key locked-cb]
+    (let [fn     (str (uuid key))
+          f      (io/file (str folder "/Data/" fn))
+          res-ch (chan)]
+      (binary-read f res-ch folder fn key locked-cb)
+      res-ch))
+
+  (-bassoc [this key input]
+    (let [file-name    (uuid key)
+          key-folder   (str folder "/Key/")]
+      (async/thread
+        (do (write-edn-key serializer write-handlers read-handlers key-folder file-name {:key key :format :binary} config)
+            (write-binary folder (str file-name) key input config))))))
+
+(defmethod print-method FileSystemStore
+  [store writer]
+  (.write writer (str "FileStore[\"" (:folder store ) ", " (.hasheq store) "\"]")))
+
+(defn- check-and-create-folder [path]
+  (let [f         (io/file path)
+        test-file (io/file (str path "/" (java.util.UUID/randomUUID)))]
+        (when-not (.exists f)
+          (.mkdir f))
+        ;; simple test to ensure we can write to the folders
+        (when-not (.createNewFile test-file)
+          (throw (ex-info "Cannot write to folder." {:type   :not-writable
+                                                     :folder path})))
+        (.delete test-file)))
+
+(defn filestore-schema-update
   "Lists all keys in this binary store. This operation *does not block concurrent operations* and might return an outdated key set. Keys of binary blobs are not tracked atm."
   [{:keys [folder serializer read-handlers] :as store}]
   (let [fns (->> (io/file folder)
                  .list
                  seq
+                 ((fn [e] (prn "foo: " e) e))
                  (filter #(re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}"
                                       %))
                  (map (fn [fn]
@@ -65,7 +363,9 @@
                            (when (.exists f)
                              (let [fis (DataInputStream. (FileInputStream. f))]
                                (try
-                                 (first (-deserialize serializer read-handlers fis))
+                                 (let [[key value] (-deserialize serializer read-handlers fis)]
+                                   (<! (-assoc-in store key value))
+                                   (.delete f))
                                  (catch Exception e
                                    (ex-info "Could not read key."
                                             {:type :read-error
@@ -77,426 +377,107 @@
                  (async/into #{}))]
         fns))

-
-(defrecord FileSystemStore [folder serializer read-handlers write-handlers locks config]
-  PEDNAsyncKeyValueStore
-  (-exists? [this key]
-    (let [fn (uuid key)
-          bfn (str "B_" (uuid key))
-          f (io/file (str folder "/" fn))
-          bf (io/file (str folder "/" bfn))
-          res (chan)]
-      (put! res (or (.exists f) (.exists bf)))
-      (close! res)
-      res))
-
-  ;; non-blocking async version
-  (-get-in [this key-vec]
-    (let [[fkey & rkey] key-vec
-          fn (uuid fkey)
-          f (io/file (str folder "/" fn))
-          res-ch (chan)]
-      (if-not (.exists f)
-        (close! res-ch)
-        (try
-          (let [ac (AsynchronousFileChannel/open (.getPath (FileSystems/getDefault)
-                                                           (str folder "/" fn)
-                                                           (into-array String []))
-                                                 (into-array StandardOpenOption
-                                                             [StandardOpenOption/READ]))
-                bb (ByteBuffer/allocate (.size ac))]
-            (.read ac
-                   bb
-                   0
-                   nil
-                   (proxy [CompletionHandler] []
-                     (completed [res att]
-                       (let [bais (ByteArrayInputStream. (.array bb))]
-                         (try
-                           (put! res-ch
-                                 (get-in
-                                  (second (-deserialize serializer read-handlers bais))
-                                  rkey))
-                           (catch Exception e
-                             (ex-info "Could not read key."
-                                      {:type :read-error
-                                       :key fkey
-                                       :exception e}))
-                           (finally
-                             (.close ac)))))
-                     (failed [t att]
-                       (put! res-ch (ex-info "Could not read key."
-                                             {:type :read-error
-                                              :key fkey
-                                              :exception t}))
-                       (.close ac)))))
-          (catch Exception e
-            (put! res-ch (ex-info "Could not read key."
-                               {:type :read-error
-                                :key fkey
-                                :exception e})))))
-      res-ch))
-
-  (-update-in [this key-vec up-fn]
-    (async/thread
-      (let [[fkey & rkey] key-vec
-            fn (uuid fkey)
-            f (io/file (str folder "/" fn))
-            new-file (io/file (str folder "/" fn ".new"))]
-        (let [old (when (.exists f)
-                    (let [fis (DataInputStream. (FileInputStream. f))]
-                      (try
-                        (second (-deserialize serializer read-handlers fis))
-                        (catch Exception e
-                          (ex-info "Could not read key."
-                                   {:type :read-error
-                                    :key fkey
-                                    :exception e}))
-                        (finally
-                          (.close fis)))))
-              fos (FileOutputStream. new-file)
-              dos (DataOutputStream. fos)
-              fd (.getFD fos)
-              new (if-not (empty? rkey)
-                    (update-in old rkey up-fn)
-                    (up-fn old))]
-          (if (instance? Throwable old)
-            old ;; return read error
-            (try
-              (-serialize serializer dos write-handlers [key-vec new])
-              (.flush dos)
-              (when (:fsync config)
-                (.sync fd))
-              (.close dos)
-              (Files/move (.toPath new-file) (.toPath f)
-                          (into-array [StandardCopyOption/ATOMIC_MOVE]))
-              (when (:fsync config)
-                (sync-folder folder))
-              [(get-in old rkey)
-               (get-in new rkey)]
-              (catch Exception e
-                (.delete new-file)
-                ;; TODO maybe need fsync new-file here?
-                (ex-info "Could not write key."
-                         {:type :write-error
-                          :key fkey
-                          :exception e}))
-              (finally
-                (.close dos))))))))
-
-  (-assoc-in [this key-vec val] (-update-in this key-vec (fn [_] val)))
-
-  (-dissoc [this key]
-    (async/thread
-      (let [fn (uuid key)
-            f (io/file (str folder "/" fn))]
-        (.delete f)
-        (when (:fsync config)
-          (sync-folder folder))
-        nil)))
-
-  PBinaryAsyncKeyValueStore
-  (-bget [this key locked-cb]
-    (let [fn (str "B_" (uuid key))
-          f (io/file (str folder "/" fn))
-          res-ch (chan)]
-      (if-not (.exists f)
-        (close! res-ch)
-        (try
-          (let [ac (AsynchronousFileChannel/open (.getPath (FileSystems/getDefault)
-                                                           (str folder "/" fn)
-                                                           (into-array String []))
-                                                 (into-array StandardOpenOption
-                                                             [StandardOpenOption/READ]))
-                bb (ByteBuffer/allocate (.size ac))]
-            (.read ac
-                   bb
-                   0
-                   nil
-                   (proxy [CompletionHandler] []
-                     (completed [res att]
-                       (let [bais (ByteArrayInputStream. (.array bb))]
-                         (try
-                           (locked-cb {:input-stream bais
-                                       :size (.length f)
-                                       :file f})
-                           (catch Exception e
-                             (ex-info "Could not read key."
-                                      {:type :read-error
-                                       :key key
-                                       :exception e}))
-                           (finally
-                             (close! res-ch)
-                             (.close ac)))))
-                     (failed [t att]
-                       (put! res-ch (ex-info "Could not read key."
-                                             {:type :read-error
-                                              :key key
-                                              :exception t}))
-                       (close! res-ch)
-                       (.close ac)))))
-          (catch Exception e
-            (put! res-ch (ex-info "Could not read key."
-                               {:type :read-error
-                                :key key
-                                :exception e})))))
-      res-ch))
-
-  (-bassoc [this key input]
-    (let [fn (uuid key)
-          f (io/file (str folder "/B_" fn))
-          new-file (io/file (str folder "/B_" fn ".new"))]
-      (async/thread
-        (let [fos (FileOutputStream. new-file)
-              dos (DataOutputStream. fos)
-              fd (.getFD fos)]
-          (try
-            (io/copy input dos)
-            (.flush dos)
-            (when (:fsync config)
-              (.sync fd))
-            (.close fos) ;; required for windows
-            (Files/move (.toPath new-file) (.toPath f)
-                        (into-array [StandardCopyOption/ATOMIC_MOVE]))
-            (when (:fsync config)
-              (sync-folder folder))
-            (catch Exception e
-              (.delete new-file)
-              (ex-info "Could not write key."
-                       {:type :write-error
-                        :key key
-                        :exception e}))
-            (finally
-              (.close fos))))))))
-
-(defmethod print-method FileSystemStore
-  [store writer]
-  (.write writer (str "FileStore[\"" (:folder store ) ", " (.hasheq store) "\"]")))
-
 (defn new-fs-store
-  [path & {:keys [serializer read-handlers write-handlers config]
-           :or {serializer (ser/fressian-serializer)
-                read-handlers (atom {})
-                write-handlers (atom {})
-                config {:fsync true}}}]
-  (let [f (io/file path)
-        locks (atom {})
-        test-file (io/file (str path "/" (java.util.UUID/randomUUID)))]
-    (when-not (.exists f)
-      (.mkdir f))
-    ;; simple test to ensure we can write to the folder
-    (when-not (.createNewFile test-file)
-      (throw (ex-info "Cannot write to folder." {:type :not-writable
-                                                 :folder path})))
-    (.delete test-file)
-    (go
-      (map->FileSystemStore {:folder path
-                             :serializer serializer
-                             :read-handlers read-handlers
-                             :write-handlers write-handlers
-                             :locks locks
-                             :config config}))))
-
-
-
+  "Filestore contains a Key and a Data Folder"
+  [path  & {:keys [serializer read-handlers write-handlers config automatic-schema-update]
+            :or   {serializer     (ser/fressian-serializer)
+                   read-handlers  (atom {})
+                   write-handlers (atom {})
+                   config         {:fsync true}
+                   automatic-schema-update false}}]
+  (println "auto: " automatic-schema-update)
+  (let [_          (check-and-create-folder path)
+        old-format? (not (empty? (filter #(re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}" %)
+                                                      (seq (.list (io/file path))))))
+        key-path   (str path "/Key")
+        data-path  (str path "/Data")
+        _          (check-and-create-folder key-path)
+        _          (check-and-create-folder data-path)
+        store (map->FileSystemStore {:folder         path
+                                     :serializer     serializer
+                                     :read-handlers  read-handlers
+                                     :write-handlers write-handlers
+                                     :locks          (atom {})})]
+    (if (and old-format? (true? automatic-schema-update))
+      (do
+        (go
+          (println "Updating to new store schema.")
+          (<! (filestore-schema-update store))
+          store))
+      (go store))))

 (comment

-
-(def ac
-  (AsynchronousFileChannel/open (.getPath (FileSystems/getDefault)
-                                          "/tmp/atest"
-                                          (into-array String []))
-                                (into-array StandardOpenOption
-                                            [StandardOpenOption/WRITE
-                                             StandardOpenOption/CREATE])))
-
-(proxy [CompletionHandler] []
-  (completed [res att]
-    (prn "completed" res att))
-  (failed [t att]
-    (prn "failed" t att)))
-
-(.write ac (ByteBuffer/wrap (.getBytes "Hello World")) 0
-        nil
-        (proxy [CompletionHandler] []
-          (completed [res att]
-            (prn "completed" res att))
-          (failed [t att]
-            (prn "failed" t att))))
-
-(def ac2
-  (AsynchronousFileChannel/open (.getPath (FileSystems/getDefault)
-                                          "/tmp/atest"
-                                          (into-array String []))
-                                (into-array StandardOpenOption
-                                            [StandardOpenOption/READ])))
-
-(.size ac2)
-
-(let [bb (ByteBuffer/allocate (.size ac2))]
-  (.read ac2
-         bb
-         0
-         nil
-         (proxy [CompletionHandler] []
-           (completed [res att]
-             (prn "completed" res att (String. (.array bb))))
-           (failed [t att]
-             (prn "failed" t att)))))
-
-(def foo *1)
-
-(deref foo)
-
-
-
-
-  (def store (<!! (new-fs-store "/tmp/store2")))
-
-
-  (<!! (-assoc-in store [:bar] 42))
-
-  (<!! (-update-in store [:bar] inc))
-
-  (<!! (-get-in store [:bar]))
-
-  (<!! (-dissoc store :bar))
-
-
-  (<!! (-assoc-in store [:foo] 42))
-  (<!! (-get-in store [:foo]))
-
-  ;; investigate https://github.com/stuartsierra/parallel-async
-  (let [res (chan (async/sliding-buffer 1))
-        v (vec (range 5000))]
-    (time (->>  (range 5000)
-                (map #(-update-in store [%] (fn [_] v)))
-                async/merge
-                (async/pipeline-blocking 4 res identity)
-                <!!))) ;; 38 secs
-  (<!! (-get-in store [2000]))
-
-  (let [res (chan (async/sliding-buffer 1))
-        ba (byte-array (* 10 1024) (byte 42))]
-    (time (->>  (range 10000)
-                (map #(-bassoc store % ba))
-                async/merge
-                (async/pipeline-blocking 4 res identity)
-                #_(async/into [])
-                <!!))) ;; 19 secs
-
-
-  (let [v (vec (range 5000))]
-    (time (doseq [i (range 10000)]
-            (<!! (-assoc-in store [i] i))))) ;; 19 secs
-
-  (time (doseq [i (range 10000)]
-          (<!! (-get-in store [i])))) ;; 2706 msecs
-
-  (<!! (-get-in store [11]))
-
-  (<!! (-assoc-in store ["foo"] nil))
-  (<!! (-assoc-in store ["foo"] {:bar {:foo "baz"}}))
-  (<!! (-assoc-in store ["foo"] (into {} (map vec (partition 2 (range 1000))))))
-  (<!! (-update-in store ["foo" :bar :foo] #(str % "foo")))
-  (type (<!! (-get-in store ["foo"])))
-
-  (<!! (-assoc-in store ["baz"] #{1 2 3}))
-  (<!! (-assoc-in store ["baz"] (java.util.HashSet. #{1 2 3})))
-  (type (<!! (-get-in store ["baz"])))
-
-  (<!! (-assoc-in store ["bar"] (range 10)))
-  (.read (<!! (-bget store "bar" :input-stream)))
-  (<!! (-update-in store ["bar"] #(conj % 42)))
-  (type (<!! (-get-in store ["bar"])))
-
-  (<!! (-assoc-in store ["boz"] [(vec (range 10))]))
-  (<!! (-get-in store ["boz"]))
-
-
-
-  (<!! (-assoc-in store [:bar] 42))
-  (<!! (-update-in store [:bar] inc))
-  (<!! (-get-in store [:bar]))
-
-  (import [java.io ByteArrayInputStream ByteArrayOutputStream])
-  (let [ba (byte-array (* 10 1024 1024) (byte 42))
-        is (io/input-stream ba)]
-    (time (<!! (-bassoc store "banana" is))))
-  (def foo (<!! (-bget store "banana" identity)))
-  (let [ba (ByteArrayOutputStream.)]
-    (io/copy (io/input-stream (:input-stream foo)) ba)
-    (alength (.toByteArray ba)))
-
-  (<!! (-assoc-in store ["monkey" :bar] (int-array (* 10 1024 1024) (int 42))))
-  (<!! (-get-in store ["monkey"]))
-
-  (<!! (-assoc-in store [:bar/foo] 42))
-
-  (defrecord Test [a])
-  (<!! (-assoc-in store [42] (Test. 5)))
-  (<!! (-get-in store [42]))
-
-
-
-  (assoc-in nil [] {:bar "baz"})
-
-
-
-
-
-  (defrecord Test [t])
-
-  (require '[clojure.java.io :as io])
-
-  (def fsstore (io/file "resources/fsstore-test"))
-
-  (.mkdir fsstore)
-
-  (require '[clojure.reflect :refer [reflect]])
-  (require '[clojure.pprint :refer [pprint]])
-  (require '[clojure.edn :as edn])
-
-  (import '[java.nio.channels FileLock]
-          '[java.nio ByteBuffer]
-          '[java.io RandomAccessFile PushbackReader])
-
-  (pprint (reflect fsstore))
-
-
-  (defn locked-access [f trans-fn]
-    (let [raf (RandomAccessFile. f "rw")
-          fc (.getChannel raf)
-          l (.lock fc)
-          res (trans-fn fc)]
-      (.release l)
-      res))
-
-
-  ;; doesn't really lock on quick linux check with outside access
-  (locked-access (io/file "/tmp/lock2")
-                 (fn [fc]
-                   (let [ba (byte-array 1024)
-                         bf (ByteBuffer/wrap ba)]
-                     (Thread/sleep (* 60 1000))
-                     (.read fc bf)
-                     (String. (java.util.Arrays/copyOf ba (.position bf))))))
-
-
-  (.createNewFile (io/file "/tmp/lock2"))
-
-  (.renameTo (io/file "/tmp/lock2") (io/file "/tmp/lock-test"))
-
-
-  (.start (Thread. (fn []
-                     (locking "foo"
-                       (println "locking foo and sleeping...")
-                       (Thread/sleep (* 60 1000))))))
-
-  (locking "foo"
-    (println "another lock on foo"))
-
-  (time (doseq [i (range 10000)]
-          (spit (str "/tmp/store/" i) (pr-str (range i)))))
+  (time (def store (<!! (new-fs-store "/tmp/old-CCCP" :automatic-schema-update true))))
+
+  (<!! (-assoc-in store [":123"] 43))
+
+  (<!! (-update-in store [":123"] inc))
+
+  (<!! (-get-in store [["51"]]))
+
+  (<!! (-dissoc store ":123"))
+
+  (filter #(re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}" %)
+                       (seq (.list (io/file "/tmp/old-CCCP"))))
+
+
+  (seq (.list (io/file "/tmp/old-CCCP")))
+
+(<!! (filestore-schema-update store))
+
+
+
+
+
+
+
+
+
+
+ (time (doseq [i (apply vector (range 1 1000))]
+                          (<!! (-assoc-in store [(str i)] i))))
+
+ (<!! (list-keys store))
+
+ (defn myfunc []
+   2)
+
+ (= (myfunc) 2)
+
+ (= (inc) 2)
+
+ (myfunc)
+
+ (seq (.list (io/file "/tmp/CCCP/Key")))
+
+
+  (defn file->bytes [file]
+    (with-open [xin  (io/input-stream file)
+                xout (java.io.ByteArrayOutputStream.)]
+      (io/copy xin xout)
+      (.toByteArray xout)))
+
+  (<!! (-bassoc store :exe (file->bytes (io/file "/tmp/CCCP/Data/test.txt"))))
+
+  (defn copy-fn [blob]
+    (let [is   (:input-stream blob)
+          baos (ByteArrayOutputStream.)
+          _    (io/copy is baos)
+          bais (ByteArrayInputStream. (.toByteArray baos))]
+      bais))
+
+  (with-open [in  (<!! (-bget store :exe copy-fn))
+              out (io/output-stream (io/file "/tmp/CCCP/Data/testo.txt"))]
+    (io/copy in out))
+
+  (def foo (<!! (-bget store :test identity)))
+
+  (<!! (-bget store :exe copy-fn))
+
+
+  (<!! (list-keys store))
+
+
   )
+


draw x's for missed buttons

draw x's for missed buttons

--- src/makerbar/pov/game.clj
+++ src/makerbar/pov/game.clj
@@ -33,9 +33,9 @@
   "Returns a seq of random button ids. The length of the seq will at least 1 and at most num-buttons, but may be some number in between."
   [num-buttons]
   (let [button-ids (vec (keys button-coords))]
-    (distinct
-      (for [i (range num-buttons)]
-        (get button-ids (rand-int 8))))))
+    (apply hash-set
+           (for [i (range num-buttons)]
+             (get button-ids (rand-int 8))))))

 (def arrow-angles
   {:north-west (* p/TAU -0.125)
@@ -54,16 +54,22 @@
     (p/rotate (get arrow-angles button-id))
     (p/shape [-5 10] [-5 0] [-10 0] [0 -10] [10 0] [5 0] [5 10])))

+(defn draw-x []
+  (p/with-matrix
+    (p/rotate (/ p/TAU 8))
+    (p/shape [-10 -4] [-4 -4] [-4 -10] [4 -10] [4 -4] [10 -4]
+             [10 4] [4 4] [4 10] [-4 10] [-4 4] [-10 4])))
+
 (def button-size 20)
 (def button-spacing button-size)

-(defn draw-buttons
-  [buttons]
+(defn draw-button-glyphs
+  [buttons glyph-fn]
   (doseq [b buttons
           :let [[dx dy] (get button-coords b)]]
     (p/with-matrix
       (p/translate (* dx button-spacing) (* dy button-spacing))
-      (draw-arrow b))))
+      (glyph-fn b))))

 (defn draw-button-border []
   (let [s (+ button-spacing (/ button-size 2) 2)]
@@ -77,39 +83,48 @@
   (reify UiMode

     (init [_]
-      (reset! game-state {:ddr-a          {:feets 2
-                                           :score 0}
-                          :ddr-b          {:feets 2
-                                           :score 0}
-                          :target-pattern (rand-pattern 2)}))
+      (reset! game-state {:ddr-a   {:feets 2
+                                    :score 5}
+                          :ddr-b   {:feets 2
+                                    :score 5}
+                          :pattern (rand-pattern 2)}))

     (draw [_]
       ; clear
       (p/background 0)

-      (p/with-style
-        (p/stroke 255 0 0)
-        (p/text (pr-str (:target-pattern @game-state)) 0 20))
-
       (p/with-matrix
         (p/translate [(/ 224 2) (/ 102 2)])

-        ; draw ddr A buttons
-        (p/with-style
-          (p/fill 0 0 255 128)
-          (draw-buttons (map first (filter second (get-in @game-state [:ddr-a :buttons])))))
-
-        ; draw ddr B buttons
-        (p/with-style
-          (p/fill 255 0 0 128)
-          (draw-buttons (map first (filter second (get-in @game-state [:ddr-b :buttons])))))
-
-        ; draw target pattern
-        (p/with-style
-          (p/stroke 255)
-          (p/no-fill)
-          (draw-buttons (get-in @game-state [:target-pattern]))
-          (draw-button-border))))
+        (let [pattern (get-in @game-state [:pattern])
+              a-buttons (->> (get-in @game-state [:ddr-a :buttons])
+                             (filter second)
+                             (map first))
+              b-buttons (->> (get-in @game-state [:ddr-b :buttons])
+                             (filter second)
+                             (map first))]
+          ; draw ddr A buttons
+          (p/with-style
+            (p/fill 0 0 255 128)
+            (draw-button-glyphs a-buttons (fn [b]
+                                            (if (some #{b} pattern)
+                                              (draw-arrow b)
+                                              (draw-x)))))
+
+          ; draw ddr B buttons
+          (p/with-style
+            (p/fill 255 0 0 128)
+            (draw-button-glyphs b-buttons (fn [b]
+                                            (if (some #{b} pattern)
+                                              (draw-arrow b)
+                                              (draw-x)))))
+
+          ; draw target pattern
+          (p/with-style
+            (p/stroke 255)
+            (p/no-fill)
+            (draw-button-glyphs pattern draw-arrow)
+            (draw-button-border)))))

     (ddr-button-pressed [_ evt]
       (when (jaeger evt :north) (s/inc-pov-offset [0 -1]))


Работает выборка ресурса и сохранение/обновление таблицы

--- src/lotsbox/core.clj
+++ src/lotsbox/core.clj
@@ -18,6 +18,8 @@
             [net.cgrand.enlive-html :as h]

             [overtone.at-at :as at]
+
+            [clj-time.core :as tco]
             [clj-time.format :as tf]
             [clj-time.coerce :as tc]
             )
@@ -44,68 +46,13 @@
   (table :lots)
   (pk :id))

+;; UTILS -------------------------------------------------------------------------------------------
+
+(defn ->->> [x f & xx]
+  "Функция - модификатор вызова в потоке"
+  (apply f (conj (vec xx) x)))

 ;; PARSER ------------------------------------------------------------------------------------------
-
-
-;; (defn comic-titles
-;;   [n]
-;;   (let [dom (h/html-resource
-;;              (java.net.URL. "http://xkcd.com/archive"))
-;;         title-nodes (h/select dom [:#middleContainer :a])
-;;         titles (map h/text title-nodes)]
-;;     (take n titles)))
-
-;; (defn parse1 [] (h/html-resource
-;;              (java.net.URL. "http://linux.org.ru")))
-
-
-
-;; (defn tender-sk-kz-lots []
-;;   "Распарсить сайт"
-
-;;   (let [dom  (h/html-resource  (java.net.URL. "http://tender.sk.kz/index.php/ru/lots"))
-;;         rows (h/select dom [:.showtab :tr])
-
-;;         ]
-
-;;     (first (map
-;;             #(h/select % [:td])
-
-;;             (rest rows)))
-
-;;     ))
-
-;; (defn tender-sk-kz-lots []
-;;   "Распарсить сайт"
-;;   ((comp
-
-;;     first
-;;     (partial map
-;;              (fn [x] (map #(first (% :content)) x)))
-
-;;     (partial map #(h/select % [:td]))
-;;     rest
-;;     #(h/select % [:.showtab :tr])
-;;     ) (h/html-resource (java.net.URL. "http://tender.sk.kz/index.php/ru/lots"))))
-
-
-;; (def column-keys
-;;   "Колонки метаданных"
-;;   [:stat
-;;    :keyname
-;;    :caption
-;;    :description
-;;    :sum_all
-;;    :place
-;;    :bdate
-;;    :edate])
-
-
-(defn get-two-row [i1 i2 rows]
-  "Тестовая функция"
-  [(get (vec rows) i1) (get (vec rows) i2)])
-

 (defn get-cell-and-parse [parser h-cells]
   "Функция разбора значений строки"
@@ -119,42 +66,62 @@

      {} ks)))

-
 (defn do-parse-rows [parser h-rows]
   "Разбор всех строк"
   (map #(get-cell-and-parse parser %) h-rows))

+;; tender.sk.kz ------------------------------------------------------------------

-(defn ->->> [x f & xx]
-  "Функция - модификатор вызова"
-  (apply f (conj (vec xx) x)))
+(defn tender-sk-kz-lots []
+  "Получение данных лотов по адресу http://tender.sk.kz/index.php/ru/lots"
+  (let [res  "tender.sk.kz"
+        url  "http://tender.sk.kz/index.php/ru/lots"]
+    (-> (h/html-resource (java.net.URL. url))
+        (h/select [:.showtab :tr])
+        rest ;; Убираем шапку таблицы, берем только тело
+        (->->> map #(h/select % [:td]))
+        (->->> map (fn [x] (map #(first (% :content)) x)))
+        (->->> do-parse-rows {:keyname [0,str]
+                              :caption [2,#(first (% :content))]
+                              :description [3,str]
+                              :sum_all [6, #(bigdec (-> %
+                                                        (clojure.string/replace #" " "")
+                                                        (clojure.string/replace #"," ".")))]
+
+                              :bdate [8,#(tc/to-sql-date (tf/parse (tf/formatter "dd-MM-yyyy") %)) ]
+                              :edate [9,#(tc/to-sql-date (tf/parse (tf/formatter "dd-MM-yyyy") %)) ]

-
-(defn tender-sk-kz-lots []
-  (-> (h/html-resource (java.net.URL. "http://tender.sk.kz/index.php/ru/lots"))
-      (h/select [:.showtab :tr])
-      rest ;; Убираем шапку таблицы
-      (->->> map #(h/select % [:td]))
-      (->->> map (fn [x] (map #(first (% :content)) x)))
-      (->->> do-parse-rows {:keyname [0,str]
-                            :caption [2,#(first (% :content))]
-                            :description [3,str]
-                            :sum_all [6, #(bigdec (-> %
-                                                    (clojure.string/replace #" " "")
-                                                    (clojure.string/replace #"," ".")))]
-
-                            :bdate [8,#(tc/to-sql-date (tf/parse (tf/formatter "dd-MM-yyyy") %)) ]
-                            :edate [9,#(tc/to-sql-date (tf/parse (tf/formatter "dd-MM-yyyy") %)) ]
+                              :place [10,str]

-                            :place [10,str]
+                              } )

-                            } )
-      ;;first
-      ))
+        ;; Добавление служебной информации
+        (->->> map #(assoc % :url url :res res :updated (tc/to-sql-time (tco/now)) ))
+
+        ;;first
+        )))
+
+;;(insert lots (values (tender-sk-kz-lots)))

+;; tender.sk.kz ...

+(defn insert-update-rows [rows]
+  "Дополнить/обновить записи"
+  (->> rows
+       (map (fn [{res :res keyname :keyname  :as row}]
+              (let [r (update lots (set-fields row) (where (and (= :res res) (= :keyname keyname))))]
+                (if (nil? r) row nil))))
+
+       (filter #(not (nil? %)))
+
+       (#(if (empty? %) :only-updated
+            (do (insert lots (values %)) :updated-and-inserted)))))
+
+
+
+