Add Old Konserve Filestores support.

Add Old Konserve Filestores support.

--- src/konserve/filestore.clj
+++ src/konserve/filestore.clj
@@ -7,7 +7,7 @@
    [incognito.fressian :refer [incognito-read-handlers
                                incognito-write-handlers]]
    [konserve.protocols :refer [PEDNAsyncKeyValueStore
-                               -get -get-meta -update-in -dissoc -assoc-in
+                               -get -get-meta -get-version -update-in -dissoc -assoc-in
                                PBinaryAsyncKeyValueStore -bget -bassoc
                                -serialize -deserialize
                                PKeyIterable
@@ -23,14 +23,13 @@
    [java.nio.file Files StandardCopyOption FileSystems Path Paths OpenOption LinkOption
     StandardOpenOption FileVisitOption]))

-
-
-
 (defn- sync-folder
   "Helper Function to Synchrenize the Folder of the Filestore"
   [folder]
   (let [p (.getPath (FileSystems/getDefault) folder (into-array String []))
-        fc (FileChannel/open p (into-array OpenOption []))]
+        fc (FileChannel/open p
+
+(into-array OpenOption []))]
     (.force fc true)
     (.close fc)))

@@ -157,16 +156,17 @@
           (.clear buffer)
           (.close bos)))))

+;TODO merge 2-8 byte
 (defn- update-file
   "Write File into Filesystem. It Write first the meta-size, that is stored in (1Byte), the meta-data and the actual data."
-  [folder config path serializer write-handlers buffer-size [key & rkey] {:keys [file-name up-fn up-fn-args up-fn-meta type config operation input msg]} [old-meta old-value]]
+  [folder config path serializer write-handlers buffer-size [key & rkey] {:keys [version file-name up-fn up-fn-args up-fn-meta type config operation input msg]} [old-meta old-value]]
   (try
     (let [path-new             (Paths/get (str file-name ".new") (into-array String []))
           standard-open-option (into-array StandardOpenOption
                                            [StandardOpenOption/WRITE
                                             StandardOpenOption/CREATE])
           ac-new               (AsynchronousFileChannel/open path-new standard-open-option)
-          meta                 (apply up-fn-meta old-meta up-fn-args)
+          meta                 (up-fn-meta old-meta)
           value                (when (= operation :write-edn)
                                  (if-not (empty? rkey)
                                    (apply update-in old-value rkey up-fn up-fn-args)
@@ -176,7 +176,7 @@
           meta-size            (.size bos)
           _                    (.close bos)
           start-byte           (+ Long/BYTES meta-size)
-          byte-array           (byte-array Long/BYTES (list meta-size))]
+          byte-array           (byte-array Long/BYTES [version meta-size])]
       (go-try
         (<? (write-edn ac-new key serializer write-handlers 0 meta byte-array))
         (<? (if (= operation :write-binary)
@@ -213,9 +213,13 @@
                                        value      (fn-read bais-value)
                                        _          (.close bais-value)]
                                    (put! res-ch [meta value]))
-          :read-binary           (go (>! res-ch (<! (locked-cb {:input-stream (ByteArrayInputStream. (.array bb))
-                                                                :size         file-size
-                                                                :file         file-name})))))
+          :read-version          (let [bais    (ByteArrayInputStream. (.array bb))
+                                       version (.read bais)
+                                       _       (.close bais)]
+                                   (put! res-ch version))
+          :read-binary (go (>! res-ch (<! (locked-cb {:input-stream (ByteArrayInputStream. (.array bb))
+                                                      :size         file-size
+                                                      :file         file-name})))))
           (catch Exception e
             (put! res-ch (ex-info "Could not read key."
                             (assoc msg :exception e))))))
@@ -231,13 +235,16 @@
                                             (= operation :write-edn)                                   {:bb         (ByteBuffer/allocate file-size)
                                                                                :start-byte Long/BYTES
                                                                                :stop-byte  file-size}
+                                            (= operation :read-version)                                {:bb         (ByteBuffer/allocate 1)
+                                                                                :start-byte 0
+                                                                                :stop-byte  1}
                                             (or (= operation :read-meta)  (= operation :write-binary)) {:bb         (ByteBuffer/allocate meta-size)
                                                                                :start-byte Long/BYTES
                                                                                :stop-byte  (+ meta-size Long/BYTES)}
                                             :else                                                      {:bb         (ByteBuffer/allocate (- file-size meta-size Long/BYTES))
                                                                                :start-byte (+ meta-size Long/BYTES)
                                                                                :stop-byte  file-size})
-        res-ch (chan)]
+        res-ch                            (chan)]
     (go-try
       (.read ac bb start-byte stop-byte
           (completion-read-handler res-ch bb meta-size file-size env
@@ -245,13 +252,14 @@
       (<? res-ch)
       (finally
         (.clear bb)))))
-
+                                        ;TODO here trigger for version or after?
+                                        ;TODO migrate namespace => automate migration
 (defn completion-read-meta-size-handler
   "Callback Function for io/operation. Return the Meta-size that are stored in the ByteBuffer."
   [res-ch ^ByteBuffer bb msg]
   (proxy [CompletionHandler] []
     (completed [res att]
-      (let [bais      (ByteArrayInputStream. (.array bb))
+      (let [bais      (ByteArrayInputStream. (.array bb) 1 7)
             meta-size (.read bais)
             _         (.close bais)]
         (try
@@ -293,47 +301,120 @@
          async/merge
          (async/into #{}))))

-(defn- io-operation
-  "Read/Write File with AsynchronousFileChannel. For better understanding use Flow-Chart of Konserve."
-  [key-vec folder config serializer read-handlers write-handlers buffer-size {:keys [operation msg] :as env}]
-  (let [key          (first  key-vec)
-        fn           (str folder "/" (uuid key))
-        env          (assoc env :file-name fn)
-        path         (Paths/get fn (into-array String []))
-        file-exists? (Files/exists path (into-array LinkOption []))]
-    (if (or file-exists? (= :write-edn operation) (= :write-binary operation))
-      (let [standard-open-option (if file-exists?
-                                   (into-array StandardOpenOption [StandardOpenOption/READ])
-                                   (into-array StandardOpenOption [StandardOpenOption/WRITE
-                                                                   StandardOpenOption/CREATE]))
-            ac                   (AsynchronousFileChannel/open path standard-open-option)]
-        (if file-exists?
-          (let [bb (ByteBuffer/allocate Long/BYTES)
-                res-ch (chan)]
-            (go-try
-               (.read ac bb 0 Long/BYTES
-                      (completion-read-meta-size-handler res-ch bb
-                                                         {:type :read-meta-size-error
-                                                          :key  key}))
-               (let [meta-size (<? res-ch)
-                     old       (<? (read-file ac serializer read-handlers env meta-size))]
-                 (if (or (= :write-edn operation) (= :write-binary operation))
-                   (<? (update-file folder config path serializer write-handlers buffer-size key-vec env old))
-                   old))
-               (finally
-                 (close! res-ch)
-                 (.clear bb)
-                 (.close ac))))
-          (go-try
-              (<? (update-file folder config path serializer write-handlers buffer-size key-vec env [nil nil]))
-              (finally
-                (.close ac)))))
-      (go nil))))
+(defn completion-read-old-handler [res-ch bb serializer read-handlers msg]
+  (proxy [CompletionHandler] []
+    (completed [res att]
+      (let [bais (ByteArrayInputStream. (.array bb))]
+        (try
+          (let [value (-deserialize serializer read-handlers bais)]
+            (put! res-ch value)
+            (close! res-ch))
+          (catch Exception e
+            (ex-info "Could not read key."
+                     (assoc msg :exception e))))))))
+
+
+(defn migrate-file-v1
+  "Migration Function For Konserve Version, who has old file-schema."
+  [folder key up-fn input buffer-size version old-file-name new-file-name migrate-old-files serializer read-handlers write-handlers]
+  (let [standard-open-option (into-array StandardOpenOption [StandardOpenOption/READ])
+        new-path             (Paths/get new-file-name (into-array String []))
+        data-path            (Paths/get old-file-name (into-array String []))
+        ac-data-file         (AsynchronousFileChannel/open data-path standard-open-option)
+        binary?              (clojure.string/includes? old-file-name "B_")
+        res-ch               (chan)
+        size-data            (.size ac-data-file)
+        bb-data              (when-not binary? (ByteBuffer/allocate size-data))
+        res-ch-data          (chan)]
+    (go-try
+        (when-not binary?
+          (.read ac-data-file bb-data 0 size-data
+                 (completion-read-old-handler res-ch-data bb-data serializer read-handlers
+                                              {:type :read-data-old-error
+                                               :path data-path})))
+      (let [[_ data] (when-not binary? (<? res-ch-data))
+            env  (if binary?
+                   {:operation  :write-binary
+                    :version    version
+                    :file-name  new-file-name
+                    :input      (if input input (FileInputStream. old-file-name))
+                    :up-fn-meta (fn [_] {:key key :type :binary ::timestamp (java.util.Date.)})
+                    :msg        {:type :write-binary-error
+                                 :key  key}}
+                   {:operation  :write-edn
+                    :version    version
+                    :file-name  new-file-name
+                    :up-fn      (if up-fn (up-fn data) (fn [] data))
+                    :up-fn-meta (fn [_] {:key key :type :edn ::timestamp (java.util.Date.)})
+                    :msg        {:type :write-edn-error
+                                 :key  key}})]
+        (<? (update-file folder nil new-path serializer write-handlers buffer-size [key] env [nil nil])))
+      (finally
+        (Files/delete data-path)
+        (swap! migrate-old-files disj old-file-name)
+        (when-not binary? (.clear bb-data))
+        (close! res-ch-data)
+        (.close ac-data-file)))))
+
+(defn- migrate-file-v2
+  "Migration Function For Konserve Version, who has Meta and Data Folders.
+   Write old file into new Konserve directly."
+  [folder key up-fn input buffer-size version old-file-name new-file-name migrate-old-files serializer read-handlers write-handlers]
+  (let [standard-open-option (into-array StandardOpenOption [StandardOpenOption/READ])
+        new-path             (Paths/get new-file-name (into-array String []))
+        meta-path            (Paths/get old-file-name (into-array String []))
+        data-file-name       (clojure.string/replace old-file-name #"meta" "data")
+        data-path            (Paths/get data-file-name (into-array String []))
+        ac-meta-file         (AsynchronousFileChannel/open meta-path standard-open-option)
+        ac-data-file         (AsynchronousFileChannel/open data-path standard-open-option)
+        size-meta            (.size ac-meta-file)
+        bb-meta              (ByteBuffer/allocate size-meta)
+        res-ch-data          (chan)
+        res-ch-meta          (chan)]
+      (go-try
+          (.read ac-meta-file bb-meta 0 size-meta
+                 (completion-read-old-handler res-ch-meta bb-meta serializer read-handlers
+                                              {:type :read-meta-old-error
+                                               :path meta-path}))
+        (let [{:keys [format key]} (<? res-ch-meta)]
+          (when (= :edn format)
+            (let [size-data (.size ac-data-file)
+                  bb-data   (ByteBuffer/allocate size-data)]
+              (.read ac-data-file bb-data 0 size-data
+                     (completion-read-old-handler res-ch-data bb-data serializer read-handlers
+                                                  {:type :read-data-old-error
+                                                   :path data-path}))))
+          (let [data (when (= :edn format) (<? res-ch-data))
+                env  (if (= :edn format)
+                       {:operation  :write-edn
+                        :version    version
+                        :file-name  new-file-name
+                        :up-fn      (fn [_] data) #_(if up-fn (up-fn data) (fn [_] data))
+                        :up-fn-meta (fn [_] {:key key :type format ::timestamp (java.util.Date.)})
+                        :msg        {:type :write-edn-error
+                                     :key  key}}
+                       {:operation  :write-binary
+                        :version    version
+                        :file-name  new-file-name
+                        :input      (FileInputStream. data-file-name) #_(if input input )
+                        :up-fn-meta (fn [_] {:key key :type format ::timestamp (java.util.Date.)})
+                        :msg        {:type :write-binary-error
+                                     :key  key}})
+               _ (prn  folder nil new-path serializer write-handlers buffer-size [key] env [nil nil] )]
+            (<? (update-file folder nil new-path serializer write-handlers buffer-size [key] env [nil nil]))))
+        (finally
+          (Files/delete meta-path)
+          (Files/delete data-path)
+          (swap! migrate-old-files disj old-file-name)
+          (close! res-ch-data)
+          (.clear bb-meta)
+          (.close ac-data-file)
+          (.close ac-meta-file)))))

 (defn- delete-file
   "Remove/Delete key-value pair of Filestore by given key. If success it will return true."
   [key folder]
-  (let [fn           (str folder "/" (uuid key))
+  (let [fn           (str folder "/" (uuid key) ".ksv")
         path         (Paths/get fn (into-array String []))
         res-ch       (chan)
         file-exists? (Files/exists path (into-array LinkOption []))]
@@ -344,45 +425,100 @@
       (close! res-ch))
     res-ch))

-(defrecord FileSystemStore [folder serializer read-handlers write-handlers buffer-size locks config]
+(defn- io-operation
+  "Read/Write File with AsynchronousFileChannel. For better understanding use Flow-Chart of Konserve."
+  [key-vec folder config serializer read-handlers write-handlers buffer-size {:keys [version input up-fn detect-old-files operation msg] :as env}]
+  (let [key          (first  key-vec)
+        uuid-key (uuid key)
+        fn           (str folder "/" uuid-key ".ksv")
+        env          (assoc env :file-name fn)
+        path         (Paths/get fn (into-array String []))
+        file-exists? (Files/exists path (into-array LinkOption []))]
+    (if-let [old-file-name (first (filter #(clojure.string/includes? % (str uuid-key)) @detect-old-files))]
+      (if (clojure.string/includes? old-file-name "meta")
+        (migrate-file-v2 folder key up-fn input buffer-size version old-file-name fn detect-old-files serializer read-handlers write-handlers)
+        (migrate-file-v1 folder key up-fn input buffer-size version old-file-name fn detect-old-files serializer read-handlers write-handlers))
+      (if (or file-exists? (= :write-edn operation) (= :write-binary operation))
+        (let [standard-open-option (if file-exists?
+                                     (into-array StandardOpenOption [StandardOpenOption/READ])
+                                     (into-array StandardOpenOption [StandardOpenOption/WRITE
+                                                                     StandardOpenOption/CREATE]))
+              ac                   (AsynchronousFileChannel/open path standard-open-option)]
+          (if file-exists?
+            (let [bb (ByteBuffer/allocate Long/BYTES)
+                  res-ch (chan)]
+              (go-try
+                  (.read ac bb 0 Long/BYTES
+                         (completion-read-meta-size-handler res-ch bb
+                                                            {:type :read-meta-size-error
+                                                             :key  key}))
+                (let [meta-size (<? res-ch)
+                      old       (<? (read-file ac serializer read-handlers env meta-size))]
+                  (if (or (= :write-edn operation) (= :write-binary operation))
+                    (<? (update-file folder config path serializer write-handlers buffer-size key-vec env old))
+                    old))
+                (finally
+                  (close! res-ch)
+                  (.clear bb)
+                  (.close ac))))
+            (go-try
+                (<? (update-file folder config path serializer write-handlers buffer-size key-vec env [nil nil]))
+              (finally
+                (.close ac)))))
+        (go nil)))))
+
+(defrecord FileSystemStore [folder serializer read-handlers write-handlers buffer-size detect-old-version locks config version]
   PEDNAsyncKeyValueStore
   (-get [this key]
     (io-operation [key] folder config serializer read-handlers write-handlers buffer-size {:operation :read-edn
                                                                                :format    :data
+                                                                                :version version
+                                                                                :detect-old-files detect-old-version
                                                                                :msg       {:type :read-edn-error
                                                                                :key  key}}))
   (-get-meta [this key]
     (io-operation [key] folder config serializer read-handlers write-handlers buffer-size {:operation :read-meta
+                                                                                :detect-old-files detect-old-version
+                                                                                :version version
                                                                                :msg       {:type :read-meta-error
+                                                                                :key  key}}))
+  (-get-version [this key]
+    (io-operation [key] folder config serializer read-handlers write-handlers buffer-size {:operation :read-version
+                                                                                :detect-old-files detect-old-version
+                                                                                :version version
+                                                                                :msg       {:type :read-version-error
                                                                                :key  key}}))
   (-assoc-in [this key-vec meta-up val] (-update-in this key-vec meta-up (fn [_] val) []))
   (-update-in [this key-vec meta-up up-fn args]
     (io-operation key-vec folder config serializer read-handlers write-handlers buffer-size {:operation  :write-edn
+                                                                                :detect-old-files detect-old-version
+                                                                                :version version
                                                                                :up-fn      up-fn
                                                                                :up-fn-args args
                                                                                :up-fn-meta meta-up
                                                                                :config     config
                                                                                :msg        {:type :write-edn-error
                                                                                :key  (first key-vec)}}))
-
-
-
   (-dissoc [this key]
     (delete-file key folder))
   PBinaryAsyncKeyValueStore
   (-bget [this key locked-cb]
     (io-operation [key] folder config serializer read-handlers write-handlers buffer-size {:operation :read-binary
-                                                                                :config    config
-                                                                                :locked-cb locked-cb
-                                                                                :msg       {:type :read-binary-error
-                                                                                :key  key}}))
+                                                                                :detect-old-files detect-old-version
+                                                                                :config    config
+                                                                                :version version
+                                                                                :locked-cb locked-cb
+                                                                                :msg       {:type :read-binary-error
+                                                                                :key  key}}))
   (-bassoc [this key meta-up input]
     (io-operation [key] folder config serializer read-handlers write-handlers buffer-size {:operation  :write-binary
-                                                                                :input      input
-                                                                                :up-fn-meta meta-up
-                                                                                :config     config
-                                                                                :msg        {:type :write-binary-error
-                                                                                :key  key}}))
+                                                                                :detect-old-files detect-old-version
+                                                                                :input      input
+                                                                                :version version
+                                                                                :up-fn-meta meta-up
+                                                                                :config     config
+                                                                                :msg        {:type :write-binary-error
+                                                                                :key  key}}))
   PKeyIterable
   (-keys [this]
     (list-keys folder serializer read-handlers)))
@@ -399,6 +535,19 @@
                                                  :folder path})))
     (.delete test-file)))

+
+(defn detect-old-file-schema [folder]
+  (reduce
+   (fn [black-list path]
+     (let [file-name (-> path .toString)]
+       (if (clojure.string/includes? (-> path .getFileName .toString) "meta")
+         (into black-list (detect-old-file-schema file-name))
+         (if (clojure.string/includes? file-name ".ksv")
+           black-list
+           (into black-list [file-name])))))
+   #{}
+   (Files/newDirectoryStream (Paths/get folder (into-array String [])))))
+
 (defn new-fs-store
   "Create Filestore in given path.
   Optional serializer, read-handerls, write-handlers, buffer-size and config (for fsync) can be changed.
@@ -409,20 +558,207 @@
    :write-handlers empty
    :buffer-size    1 MB
    :config         config} "
-  [path  & {:keys [serializer read-handlers write-handlers buffer-size config]
+  [path  & {:keys [serializer read-handlers write-handlers buffer-size config version old-files]
             :or   {serializer     (ser/fressian-serializer)
                    read-handlers  (atom {})
                    write-handlers (atom {})
                    buffer-size    (* 1024 1024)
-                   config         {:fsync true}}}]
-  (let [_     (check-and-create-folder path)
-        store (map->FileSystemStore {:folder         path
-                                     :serializer     serializer
-                                     :read-handlers  read-handlers
-                                     :write-handlers write-handlers
-                                     :buffer-size buffer-size
-                                     :locks          (atom {})
-                                     :config         config})]
+                   config         {:fsync true}
+                   version        2}}]
+  (let [detect-old-version (when old-files (atom (detect-old-file-schema  "/tmp/konserve-fs-migration-test")))
+        _                  (check-and-create-folder path)
+        store              (map->FileSystemStore {:detect-old-version detect-old-version
+                                                  :folder             path
+                                                  :serializer         serializer
+                                                  :read-handlers      read-handlers
+                                                  :write-handlers     write-handlers
+                                                  :buffer-size        buffer-size
+                                                  :locks              (atom {})
+                                                  :config             config
+                                                  :version            version})]
     (go store)))

+                                        ;set =>
+;system time for meta data => java function
+;seperate migrate function
+
+(comment
+
+  (def store (<!! (new-fs-store "/tmp/konserve-fs-migration-test" :old-files true)))
+
+
+  @(:detect-old-version store)
+
+  (<!! (-get store 5))
+
+
+  (<!! (-assoc-in store ["old_x"] x))
+
+  (<!! (-get-meta store :foo))
+
+  (<!! (-get-meta store :byte-array))
+
+  (<!! (-get-meta store (str "B_" 4)))
+
+  (<!! (-get store 4))
+
+  (def folder-name "/tmp/konserve-fs-migration-test")
+
+  (def serializer (ser/fressian-serializer))
+
+  (def read-handler (atom {}))
+
+
+
+  (def write-handler (atom {}))
+
+  (defn completion-read-old-handler [res-ch bb serializer read-handlers msg]
+    (proxy [CompletionHandler] []
+      (completed [res att]
+        (let [bais (ByteArrayInputStream. (.array bb))]
+          (try
+            (let [value (-deserialize serializer read-handlers bais)]
+              (put! res-ch value)
+              (close! res-ch))
+            (catch Exception e
+              (ex-info "Could not read key."
+                       (assoc msg :exception e))))))))
+
+  ;add key and up-fn, up-meta-fn
+  (defn migrate-file-v2 [folder up-fn buffer-size version new-path meta-path data-path serializer read-handlers write-handlers]
+    (let [standard-open-option (into-array StandardOpenOption [StandardOpenOption/READ])
+          ac-meta-file         (AsynchronousFileChannel/open meta-path standard-open-option)
+          ac-data-file         (AsynchronousFileChannel/open data-path standard-open-option)
+          file-name            (str folder "/" (-> data-path .getFileName .toString) ".ksv")
+          size-meta            (.size ac-meta-file)
+          bb-meta              (ByteBuffer/allocate size-meta)
+          res-ch-data          (chan)
+          res-ch-meta          (chan)]
+      (go-try
+          (.read ac-meta-file bb-meta 0 size-meta
+                 (completion-read-old-handler res-ch-meta bb-meta serializer read-handlers
+                                              {:type :read-meta-old-error
+                                               :path meta-path}))
+        (let [{:keys [format key]} (<? res-ch-meta)]
+          (when (= :edn format)
+            (let [size-data (.size ac-data-file)
+                  bb-data   (ByteBuffer/allocate size-data)]
+              (.read ac-data-file bb-data 0 size-data
+                     (completion-read-old-handler res-ch-data bb-data serializer read-handlers
+                                                  {:type :read-data-old-error
+                                                   :path data-path}))))
+          (let [data (when (= :edn format) (<? res-ch-data))
+                env  (if (= :edn format)
+                       {:operation  :write-edn
+                        :version    version
+                        :file-name   file-name
+                        :up-fn      (fn [_] data)
+                        :up-fn-meta (fn [_] {:key key :type format ::timestamp (java.util.Date.)})
+                        :msg        {:type :write-edn-error
+                                     :key  key}}
+                       {:operation  :write-binary
+                        :version    version
+                        :file-name  file-name
+                        :input      (FileInputStream. (-> data-path .toString))
+                        :up-fn-meta (fn [_] {:key key :type format ::timestamp (java.util.Date.)})
+                        :msg        {:type :write-binary-error
+                                     :key  key}})]
+            (<? (update-file folder nil new-path serializer write-handlers buffer-size [key] env [nil nil]))))
+        (finally
+          ;delete old file
+          (close! res-ch-data)
+          (.clear bb-meta)
+          (.close ac-data-file)
+          (.close ac-meta-file)))))
+
+  ;add key and up-fn and up-meta function
+(defn migrate-file-v1 [folder buffer-size version new-path data-path serializer read-handlers write-handlers]
+  (let [standard-open-option (into-array StandardOpenOption [StandardOpenOption/READ])
+        ac-data-file         (AsynchronousFileChannel/open data-path standard-open-option)
+        file-name            (str folder "/" (-> data-path .getFileName .toString) ".ksv")
+        binary?              (clojure.string/includes? file-name "B_")
+        res-ch               (chan)
+        size-data            (.size ac-data-file)
+        bb-data              (when-not binary? (ByteBuffer/allocate size-data))
+        res-ch-data          (chan)]
+      (go-try
+          (when-not binary?
+            (.read ac-data-file bb-data 0 size-data
+                   (completion-read-old-handler res-ch-data bb-data serializer read-handlers
+                                                {:type :read-data-old-error
+                                                 :path data-path})))
+        (let [[[key] data] (when-not binary? (<? res-ch-data))
+              env  (if binary?
+                     {:operation  :write-binary
+                      :version    version
+                      :file-name  (clojure.string/replace file-name #"B_" "")
+                      :input      (FileInputStream. (-> data-path .toString))
+                      :up-fn-meta (fn [_] {:key (-> data-path .toString) :type :binary ::timestamp (java.util.Date.)})
+                      :msg        {:type :write-binary-error
+                                   :key  key}}
+                     {:operation  :write-edn
+                      :version    version
+                      :file-name  file-name
+                      :up-fn      (fn [_] data)
+                      :up-fn-meta (fn [_] {:key key :type :edn ::timestamp (java.util.Date.)})
+                      :msg        {:type :write-edn-error
+                                   :key  key}})]
+            (<? (update-file folder nil new-path serializer write-handlers buffer-size [key] env [nil nil])))
+        (finally
+          ;delete old file
+          (when-not binary? (.clear bb-data))
+          (close! res-ch-data)
+          (.close ac-data-file)))))
+;clj kondo => linter
+                                        ;=> set old files
+                                        ;life update
+(defn detect-old-file-schema [folder]
+  (reduce
+   (fn [black-list path]
+     (let [file-name (-> path .toString)]
+       (if (clojure.string/includes? (-> path .getFileName .toString) "meta")
+         (into black-list (detect-old-file-schema file-name))
+         (if (clojure.string/includes? file-name ".ksv")
+           black-list
+           (into black-list [file-name])))))
+   #{}
+   (Files/newDirectoryStream (Paths/get folder (into-array String [])))))
+
+
+  (defn check-old-version [folder buffer-size version serializer read-handlers write-handlers]
+    (let [meta-path    (Paths/get (str folder "/meta") (into-array String []))
+          meta-exists? (Files/exists meta-path (into-array LinkOption []))
+          file-paths   (when meta-exists? (Files/newDirectoryStream meta-path))]
+      (if meta-exists?
+        (doseq [file-path file-paths]
+          (when (Files/exists file-path (into-array LinkOption []))
+            (let [file-name    (-> file-path .getFileName .toString)
+                  data-path    (Paths/get (str folder "/data/" file-name) (into-array String []))
+                  data-exists? (Files/exists data-path (into-array LinkOption []))]
+              (migrate-file-v2 folder buffer-size version (Paths/get (str folder "/" file-name) (into-array String [])) file-path data-path serializer read-handlers write-handlers))))
+        (doseq [file-path (Files/newDirectoryStream (Paths/get folder (into-array String [])))]
+          (let [file-name (-> file-path .toString)]
+            (when-not (clojure.string/includes? file-name ".ksv")
+              (migrate-file-v1 folder buffer-size version (Paths/get (clojure.string/replace (str file-name ".ksv") #"B_" "") (into-array String [])) file-path serializer read-handlers write-handlers)))))))
+
+  (check-old-version folder-name (* 1024 1024) 1 serializer read-handler write-handler)
+
+  (<!! (new-fs-store "/tmp/konserve-fs-migration-test"))
+
+  (def detect-old-file (atom (detect-old-file-schema  "/tmp/konserve-fs-migration-test")))
+
+  (when (empty (filter #(clojure.string/includes? % "04145bdb-c294-5dec-95a8-4ed14d9e98f4")))
+    "e")
+
+  (empty? (filter #(clojure.string/includes? % "04145bdb-c294-5dec-95a8-4ed14d9e98f4") @detect-old-file))
+
+  (<!! (-assoc-in store [:bar2] (fn [_] "meta") {:bar :baz}))
+
+  (<!! (-get store :bar2))
+
+  (<!! (-get-meta store :bar2))
+
+  (<!! (-get-version store :bar2))
+
+)


analyze code to eval before evaluation to allow for new defs etc.

--- src/rksm/cloxp_cljs_repl/core.clj
+++ src/rksm/cloxp_cljs_repl/core.clj
@@ -2,6 +2,7 @@
   (:require [cljs.repl :as repl]
             [cljs.analyzer :as ana]
             [cljs.env :as env]
+            [cljs.analyzer.api :as ana.api]
             [cljs.tagged-literals :as tags]
             [clojure.tools.reader :as reader]
             [clojure.tools.reader.reader-types :as readers]
@@ -9,7 +10,8 @@
             [rksm.cloxp-cljs.analyzer :as cloxp-ana]
             [rksm.cloxp-com.server :as server]
             [rksm.cloxp-com.messenger :as msg]
-            [clojure.core.async :refer [>!! <!! >! <! go]]))
+            [clojure.core.async :refer [>!! <!! >! <! go]]
+            [fs.core :as fs]))

 (defn send-to-js
   [server client-id action data]
@@ -65,28 +67,44 @@
   "returns map of {:value :out :error}"
   ([form opts]
    (eval-cljs form nil opts))
-  ([form cloxp-repl-env {:keys [target-id ns-sym] :as opts}]
-   (let [opts (or opts {})
-         cloxp-repl-env (cond
-                          cloxp-repl-env cloxp-repl-env
-                          target-id (repl-env-for-client target-id)
-                          :default (default-repl-env))
-         c-env (or env/*compiler* (env/default-compiler-env))
-         ana-env (merge (ana/empty-env) {:ns 'cljs.user})]
-     (env/with-compiler-env c-env
-       (try
-         {:error nil
-          :out ""
-          :value (repl/evaluate-form cloxp-repl-env
-                                     (assoc ana-env :ns (ana/get-namespace
-                                                         (or ns-sym ana/*cljs-ns*)))
-                                     "<cloxp-cljs-repl>"
-                                     form
-                                     identity ; wrap-fn
-                                     opts)}
-         (catch Exception e {:error e
-                             :out ""
-                             :value nil}))))))
+  ([form cloxp-repl-env {:keys [target-id ns-sym file]
+                         :or {ns-sym ana/*cljs-ns*}
+                         :as opts}]
+
+   ; for the cljs compiler we need to analyze the code. If the code isn't in a
+   ; file already, put it in a temp file for ensure-ns-analyzed!
+   (let [ana-file (if (or (= file "NO_SOURCE_FILE")
+                          (= file "<doit>")
+                          (= file "<cloxp-cljs-repl>")
+                          (empty? file))
+                    (let [tmp-file (fs/temp-file "cljs-doit-" ".cljs")]
+                      (spit tmp-file (str "(ns " ns-sym ")\n" (pr-str form)))
+                      (str tmp-file))
+                    file)]
+
+     ; make sure we have a repl-env, compiler-env, ana-env...
+     (let [opts (or opts {})
+           cloxp-repl-env (cond
+                            cloxp-repl-env cloxp-repl-env
+                            target-id (repl-env-for-client target-id)
+                            :default (default-repl-env))
+           c-env (cloxp-ana/comp-env)
+           ana-env (assoc (ana/empty-env)
+                          :ns (cloxp-ana/ensure-ns-analyzed! ns-sym ana-file))]
+
+       ; this is where the unicorns go to town
+       (env/with-compiler-env c-env
+         (try
+           {:error nil
+            :out ""
+            :value (binding [cljs.analyzer/*cljs-ns* ns-sym]
+                     (repl/evaluate-form cloxp-repl-env
+                                         ana-env
+                                         (or file "<cloxp-cljs-repl>")
+                                         form
+                                         identity ; wrap-fn
+                                         opts))}
+           (catch Exception e {:error e :out "" :value nil})))))))

 (defn- eval-read-obj
   "returns a map of :parsed :value :out and :error."
@@ -121,4 +139,4 @@
    (let [c-env (env/default-compiler-env)
          ana-env (merge (ana/empty-env) {:ns 'cljs.user})]
      (env/with-compiler-env c-env
-       (cljs.repl/load-namespace cloxp-repl-env sym opts)))))
+       (cljs.repl/load-namespace cloxp-repl-env sym opts)))))


typo in cljs.js/*load-fn* docstring

typo in cljs.js/*load-fn* docstring

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -33,7 +33,7 @@
   ^{:doc "Each runtime environment provides a different way to load source.
   Whatever function *load-fn* is bound to will be passed a munged relative
   library path (a string) and a callback. It is up to the implementor to
-  correctly resolvea .cljs, .cljc, or .js file (the order must be respected).
+  orrectly resolve a .cljs, .cljc, or .js file (the order must be respected).
   The callback should be invoked with the source of the library (a string)."
     :dynamic true}
   *load-fn*


Remove AUTO_SERVER from placeholder

Remove AUTO_SERVER from placeholder

see #3916

--- src/metabase/driver/h2.clj
+++ src/metabase/driver/h2.clj
@@ -210,7 +210,7 @@
          {:date-interval                     (u/drop-first-arg date-interval)
           :details-fields                    (constantly [{:name         "db"
                                                            :display-name "Connection String"
-                                                           :placeholder  "file:/Users/camsaul/bird_sightings/toucans;AUTO_SERVER=TRUE"
+                                                           :placeholder  "file:/Users/camsaul/bird_sightings/toucans"
                                                            :required     true}])
           :humanize-connection-error-message (u/drop-first-arg humanize-connection-error-message)
           :process-query-in-context          (u/drop-first-arg process-query-in-context)})


added function to help encoding

added function to help encoding

--- src/moodtrackr/encoder.clj
+++ src/moodtrackr/encoder.clj
@@ -9,7 +9,33 @@
                     (range (int \0) (+ (int \9) 1))
                     [\+ \/])))

-;; Plumbing functions for
+;; Euclidean Algorithm
+(defn find-gcd
+  "Finds the Greatest Common Divisor of n1 and n2"
+  [n1 n2]
+  (loop [div n1
+         rep n2]
+    (if (= rep 0)
+      div
+      (recur rep (mod div rep)))))
+
+(defn find-lcm
+  "Finds the Least Common Multiple between n1 and n2"
+  [n1 n2]
+  (/ (* n1 n2) (find-gcd n1 n2)))
+
+(defn find-cycle
+  "Find the constant to determine how much padding needs to be applied."
+  [char-bits encoder-bits]
+  (/ (encoder/find-lcm 8 6) char-bits))
+
+(defn find-padding
+  "Finds the number of padding required, given how many bits per char and how many
+  bits per encoding char"
+  [ss char-bits encoder-bits]
+  (mod ss (find-cycle char-bits encoder-bits)))
+
+;; Plumbing functions for converting a string to base64 encoding
 (defn to-num-seq
   "Converts a String into a char-numeric sequence"
   [s]
@@ -48,8 +74,10 @@

 ;; Modify me for the last function call
 (defn str-to-bin
-  "Converts a string into a large binary string"
+  "Converts a string into a large binary string -- assumes 8 bits per char and 6 bits per encoding"
   [ss]
-  (-> ss
-      to-num-seq
-      to-bin-str))
+  (let [st-len (count ss)]
+    (-> (ss)
+        to-num-seq
+        to-bin-str
+        )))


Fix bug in shutdown code.

Fix bug in shutdown code.

--- src/om_event_bus/core.cljs
+++ src/om_event_bus/core.cljs
@@ -185,6 +185,6 @@
    It simply calls `shutdown` on the event bus set up in `init-event-bus!` above.
    This terminates the go loop handling events."
   [this]
-  (doseq [[bus _] (om/get-state this ::event-buses)]
+  (doseq [[_ bus] (om/get-state this ::event-buses)]
     (impl/shutdown bus))
   (om/set-state! this ::event-buses nil))                  ; TODO: Set each to nil-event-bus reporting meaningful errors.


Allow all irc config except type to be optional

--- src/yetibot/core/adapters/irc.clj
+++ src/yetibot/core/adapters/irc.clj
@@ -28,11 +28,11 @@

 (s/def ::password string?)

-(s/def ::config (s/keys :req-un [::type
+(s/def ::config (s/keys :req-un [::type]
+                        :opt-un [::username
+                                 ::ssl
                                  ::host
                                  ::port
-                                 ::username]
-                        :opt-un [::ssl
                                  ::password]))

 (declare join-or-part-with-current-channels connect start)


Added parent-node function based on reduce-tree

--- evermind.core/src/evermind/domain/core.cljc
+++ evermind.core/src/evermind/domain/core.cljc
@@ -141,6 +141,22 @@

+(defn parent-node
+  [tree node]
+  (first
+    (reduce-tree
+      tree
+      (fn [n]
+        (some
+          (fn [c] (= (-> c :id) (-> node :id)))
+          (-> n :children))))))
+
+(s/fdef parent-node
+        :args (s/cat :node ::node :node ::node)
+        :ret (s/or :not-found nil? :parent ::node))
+
+
+
 (defn create-mindmap
   ([] (create-node)))


Formatting

Formatting

--- src/onyx/peer/function.clj
+++ src/onyx/peer/function.clj
@@ -52,7 +52,8 @@
                                route
                                nil
                                (get hash-group route)))
-                     (:flow routes) ack-vals))))
+                     (:flow routes)
+                     ack-vals))))
        fast-concat))

 (defn pick-peer [active-peers hash-group]


Tweak rate of ugens to fix non-looping behaviour

--- src/overtone/sc/sample.clj
+++ src/overtone/sc/sample.clj
@@ -68,7 +68,7 @@
             phase     (phasor:ar :start start-pos :end end-pos :rate rate)
             snd       (buf-rd 1 buf phase)
             e-gate    (+ loop?
-                         (latch (a2k (line 1 0 0.002)) (a2k (bpz2 phase))))
+                         (a2k (latch:ar (line 1 0 0.0001) (bpz2 phase))))
             env       (env-gen (asr 0 1 release) :gate e-gate :action FREE)]
         (out out-bus (* amp env snd))))

@@ -85,7 +85,7 @@
             phase     (phasor:ar :start start-pos :end end-pos :rate rate)
             snd       (buf-rd 2 buf phase)
             e-gate    (+ loop?
-                         (latch (a2k (line 1 0 0.002)) (a2k (bpz2 phase))))
+                         (a2k (latch:ar (line 1 0 0.0001) (bpz2 phase))))
             env       (env-gen (asr 0 1 release) :gate e-gate :action FREE)]
         (out out-bus (* amp env snd))))


Remove duplicate test.

Remove duplicate test.

--- test/buddy/test_buddy_core.clj
+++ test/buddy/test_buddy_core.clj
@@ -52,13 +52,6 @@
           encrypted-password  (scrypt/make-password plain-password)]
       (is (scrypt/check-password plain-password encrypted-password)))))

-(deftest hmac-tests
-  (testing "hmac-sha256 tests"
-    (let [key  "foo"
-          data "bar"]
-      (is (= (bytes->hex (shmac-sha256 data "" key))
-             "58f125164e3664184898939740cd369130bca60e1f66a4dbe241f494b6403a5f")))))
-
 (deftest core-hash-tests
   (testing "SHA3 support test"
     (let [plain-text "FooBar"


fix error in test

fix error in test

--- test/crucible/aws/sns_test.clj
+++ test/crucible/aws/sns_test.clj
@@ -8,10 +8,10 @@

 (deftest sns-topic-test
   (testing "encode"
-    (is (resource= {"Type" "AWS::SNS::Topic",
-                    "Properties"
-                    {"TopicName" "SampleTopic"}}
-                   (sns/topic {::sns/topic-name "SampleTopic"})))))
+    (is (= {"Type" "AWS::SNS::Topic",
+            "Properties"
+            {"TopicName" "SampleTopic"}}
+           (rewrite-element-data (sns/topic {::sns/topic-name "SampleTopic"}))))))

@@ -32,7 +32,7 @@
                 "Principal" "*"
                 "Action" "sns:Subscribe"
                 "Resource" {"Ref" "Foo"}}]}}}
-           (enc/rewrite-element-data
+           (rewrite-element-data
             (sns/topic-policy {::sns/topics [(xref :foo :arn)]
                                ::iam/policy-document
                                {::iam/statement


More strings and numbers tests

More strings and numbers tests

--- test/spec/operations-spec.cljs
+++ test/spec/operations-spec.cljs
@@ -50,4 +50,43 @@
         (.toEqual (expect (unwrap "aa")) ""))

       (it "does nothing to an empty string"
-        (.toEqual (expect (unwrap "")) "")))))+        (.toEqual (expect (unwrap "")) ""))))
+
+  (describe "duplicate"
+    (let [duplicate (:operation (get string-ops "duplicate"))]
+      (it "duplicates a string"
+        (.toEqual (expect (duplicate "asd")) "asdasd"))
+
+      (it "does nothing to an empty string"
+        (.toEqual (expect (duplicate "")) ""))))
+
+  (describe "duplicate-last"
+    (let [duplicate-last (:operation (get string-ops "duplicate-last"))]
+      (it "duplicates the last character of a string"
+        (.toEqual (expect (duplicate-last "asd")) "asdd"))
+
+      (it "does nothing to an empty string"
+        (.toEqual (expect (duplicate-last "")) "")))))
+
+(describe "numbers"
+  (describe "rotate"
+    (let [rotate (:operation (get number-ops "rotate"))]
+      (it "rotates a number"
+        (.toEqual (expect (rotate 1234)) 4123))
+
+      (it "does nothing to a single digit number"
+        (.toEqual (expect (rotate 3)) 3))
+
+      (it "cancels leading zeros"
+        (.toEqual (expect (rotate 400)) 40))))
+
+  (describe "reverse"
+    (let [reverse (:operation (get number-ops "reverse"))]
+      (it "reverses a number"
+        (.toEqual (expect (reverse 1234)) 4321))
+
+      (it "does nothing to a single digit number"
+        (.toEqual (expect (reverse 3)) 3))
+
+      (it "cancels leading zeros"
+        (.toEqual (expect (reverse 400)) 4)))))


continue to isolate/encapsulate join internal rep

--- dada2-core/src/test/clojure/org/dada2/test_join_model.clj
+++ dada2-core/src/test/clojure/org/dada2/test_join_model.clj
@@ -37,32 +37,33 @@
 ;;--------------------------------------------------------------------------------
 ;; this layer encapsulates access to lhs index

-(defn- lhses-get [lhs-indeces i key]
-  (key (nth lhs-indeces (dec i))))
-
-(defn- lhs-assoc [old-indeces keys lhs]
+(defn- lhses-get [lhs-indeces i fk]
+  "return seq of lhses indexed by i/fk"
+  ((nth lhs-indeces (dec i)) fk))	;TODO - don't like dec here
+
+(defn- lhs-assoc [old-indeces fk-keys lhs]
   "associate a new lhs with existing index"
-  (let [[old-lhs-index & rhs-indeces] old-indeces
-	new-lhs-index (mapv (fn [index key] (group index (key lhs) lhs)) old-lhs-index keys)
+  (let [[old-lhs-index & _] old-indeces
+	new-lhs-index (mapv (fn [lhs-index fk-key] (group lhs-index (fk-key lhs) lhs)) old-lhs-index fk-keys)
 	new-indeces (assoc old-indeces 0 new-lhs-index)]
     new-indeces))

 ;;--------------------------------------------------------------------------------
 ;; this layer encapsulates access to rhs indeces

-(defn- rhs-assoc [old-indeces i value rhs]
+(defn- rhses-get [rhs-indeces fk-keys lhs]
+  "return a lazy seq of seqs of rhses indexed by their respective fks"
+  (map (fn [rhs-index fk-key] (rhs-index (fk-key lhs))) rhs-indeces fk-keys))
+
+(defn- rhs-assoc [old-indeces i fk rhs]
+  "associate a new rhs with existing index"
   (let [old-index (nth old-indeces i)
-	old-rhses (or (value old-index) [])
+	old-rhses (or (old-index fk) [])
 	new-rhses (conj old-rhses rhs)
-	new-index (assoc old-index value new-rhses)
+	new-index (assoc old-index fk new-rhses)
 	new-indeces (assoc old-indeces i new-index)]
     new-indeces
     ))
-
-(defn- rhses-get [rhs-indeces keys lhs]
-  "return a lazy seq of seqs where each seq contains the rhses which
-join the lhs via corresponding key"
-  (map (fn [index key] (index (key lhs))) rhs-indeces keys))

 ;;--------------------------------------------------------------------------------
 ;; this layer encapsulates access to both lhs and rhs at the same time...


Remove border on selected tab

Remove border on selected tab

--- frontend/styles/faceboard/css/tabs.clj
+++ frontend/styles/faceboard/css/tabs.clj
@@ -24,8 +24,7 @@
         :color "#fff"]
        (>> &.selected
          [:color "#000"
-          :background selected-tab-color
-          :border-bottom (str "1px solid " selected-tab-color)])))
+          :background selected-tab-color])))
    (>> tab-contents
      [:position :relative
       :z-index 0


add code for finding clojure compile errors

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@11073 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -64,6 +64,9 @@
   (map first
     (re-seq #"([0-9]*[1-9])\serrors?" result-text)))

+(defn clojure-errors [result-text]
+  (re-seq #"(?m)^Exception in thread.*?$" result-text))
+
 (defn device-adapter-dlls [dir]
   (filter
       (fn [file]
@@ -209,6 +212,7 @@
         vs-errors (visual-studio-errors-and-warnings bits)
         outdated-dlls (map #(.getName %) (old-dlls (bin-dir bits) 24))
         javac-errs (javac-errors result-txt)
+        clojure-errors (clojure-errors result-txt)
         outdated-jars (map #(.getName %)
                            (old-jars (File. micromanager "Install_AllPlatforms") 24))
         installer-ok (exe-on-server? bits today-token)
@@ -218,6 +222,7 @@
                    (empty? vs-errors)
                    (empty? outdated-dlls)
                    (empty? javac-errs)
+                   (empty? clojure-errors)
                    (empty? outdated-jars)
                    (empty? missing-vcproj-files)
                    (empty? missing-device-links)
@@ -231,6 +236,7 @@
         (report-segment "Visual Studio reported errors and warnings" vs-errors)
         (report-segment "Outdated device adapter DLLs" outdated-dlls)
         (report-segment "Errors reported by java compiler" javac-errs)
+        (report-segment "Errors reported by clojure compiler" clojure-errors)
         (report-segment "Outdated jar files" outdated-jars)
         (when (= 32 bits)
           (report-segment "Missing .vcproj files" missing-vcproj-files))


Attempting to get cljs working

Attempting to get cljs working

--- src/cortex/backends.cljc
+++ src/cortex/backends.cljc
@@ -1,6 +1,6 @@
 (ns cortex.backends
-  (require [clojure.core.matrix :as m])
-  #?(:clj (require [mikera.vectorz.core])))
+  (:require [clojure.core.matrix :as m])
+  #?(:clj (:require [mikera.vectorz.core])))

 #?(:clj (def ^:dynamic *current-matrix-implementation* :vectorz)


addressing missed test update (#1198)

addressing missed test update (#1198)

--- system-int-test/test/cmr/system_int_test/admin/cache_api_test.clj
+++ system-int-test/test/cmr/system_int_test/admin/cache_api_test.clj
@@ -105,6 +105,7 @@
          "acls"
          "group-ids-guids"
          "health"
+         "providers"
          "write-enabled"]
         (url/search-read-caches-url) [
          "acls"


bigger partition for aoo

bigger partition for aoo

--- src/dwc_analysis/aoo.clj
+++ src/dwc_analysis/aoo.clj
@@ -75,13 +75,13 @@
    :big-grid
      (fnk [points step]
        (->> points
-         (partition-all 10)
+         (partition-all 100)
          (pmap #(cluster-points (make-grid (* step 10) %) %))
          (reduce merge)))
    :grid
      (fnk [big-grid step]
        (->> big-grid
-         (map #(cluster-points (make-grid step (key %)) (val %)))
+         (pmap #(cluster-points (make-grid step (key %)) (val %)))
          (reduce concat)))
    :area
     (fnk [grid step]


Stick a link at the end of the calendar items

--- org-mode/src/com/gfredericks/org_agenda.clj
+++ org-mode/src/com/gfredericks/org_agenda.clj
@@ -403,7 +403,10 @@
                                                   t1)
                                                 (if (or (:todo item) (:done item))
                                                   (format-todo item)
-                                                  (:header item))))))))]
+                                                  (:header item))
+                                                ;; once we figure out enough elisp to stop using links this
+                                                ;; can just be implicit
+                                                (make-org-link item "(link)")))))))]
     (with-atomic-write-to cfg
       (when preamble
         (println preamble))


Unbox int value to ensure Integer-ness

Unbox int value to ensure Integer-ness

Fixes #64

--- server/src/main/clojure/vimclojure/repl.clj
+++ server/src/main/clojure/vimclojure/repl.clj
@@ -126,7 +126,7 @@
                    (the-repl :line)
                    line)]
     (with-bindings
-      {Compiler/LINE          line
+      {Compiler/LINE          (.intValue line) ; #64: Unbox to ensure int.
        Compiler/SOURCE        (.getName (java.io.File. file))
        Compiler/SOURCE_PATH   file
        #'*in*                 (make-reader *in* line)


Update clj-http test dependency

Update clj-http test dependency

--- ring-jetty-adapter/project.clj
+++ ring-jetty-adapter/project.clj
@@ -9,5 +9,5 @@
                  [ring/ring-servlet "1.4.0-beta1"]
                  [org.eclipse.jetty/jetty-server "7.6.13.v20130916"]]
   :profiles
-  {:dev {:dependencies [[clj-http "0.6.4"]]}
+  {:dev {:dependencies [[clj-http "1.1.2"]]}
    :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}})


Update text-font test for available in ClojureScript version font.

--- test/cljx/snippets/typography/loading_and_displaying.cljx
+++ test/cljx/snippets/typography/loading_and_displaying.cljx
@@ -72,7 +72,8 @@
 (defsnippet text-font {}
   (q/background 255)
   (q/fill 0)
-  (let [font (q/create-font "Courier New" 20)]
+  (let [font #+clj (q/create-font "Courier New" 20)
+             #+cljs (q/create-font "serif" 20)]
     (q/text-font font)
     (q/text "(print :hello)" 20 30)
     (q/text-font font 30)


removes logging of request-time (#312)

removes logging of request-time (#312)

--- waiter/src/waiter/core.clj
+++ waiter/src/waiter/core.clj
@@ -157,7 +157,8 @@
       (cid/with-correlation-id
         request-cid
         (log/info "request received:"
-                  (-> (dissoc request :body :ctrl :server-name :server-port :servlet-request :ssl-client-cert :support-info)
+                  (-> (dissoc request :body :ctrl :request-time :server-name :server-port :servlet-request
+                              :ssl-client-cert :support-info)
                       (update-in [:headers] headers/truncate-header-values)))
         (let [response (handler request)
               get-request-cid (fn get-request-cid [] request-cid)]


Update curate examples

Update curate examples

--- dev/curate.clj
+++ dev/curate.clj
@@ -88,10 +88,9 @@
 ;; the EDN files in a directory with `save-sources`.

 (comment
-  (save-sources "sources/washington/LT04046027.edn" 25)
-  (save-sources "sources/washington/LT05046027.edn" 1)
-  (save-sources "sources/washington/LE07046027.edn" 1)
-  (save-sources "sources/washington/LC8046027.edn"  25))
+  (save-sources "sources/california/H02V09-35.edn" 25)
+  (save-sources "sources/california/H02V09-627.edn" 25)
+  (save-sources "sources/california/H02V09-857.edn" 25))

 ;; Step 4: See how things are going. This will inspect the
 ;; sources table for activity and check the most recent
@@ -111,10 +110,9 @@
        (frequencies)))

 (comment
-  (progress-report "sources/washington/LT04046026.edn")
-  (progress-report "sources/washington/LT05046026.edn")
-  (progress-report "sources/washington/LE07046026.edn")
-  (progress-report "sources/washington/LC8046026.edn"))
+  (progress-report "sources/california/H02V09-35.edn")
+  (progress-report "sources/california/H02V09-627.edn")
+  (progress-report "sources/california/H02V09-857.edn"))

 ;; Create source EDN from files with checksum/source pairs.

@@ -166,31 +164,32 @@
          (util/save-edn save-path))))

 (comment
-  "This will recursively find *all* files in the `sites` directory and
-  produce an EDN file that matches the name of the immediate parent dir
-  in the input file in a directory name `outputs`.
+  "This will recursively find *all* files in a directory and produce
+  an EDN file for each input file. The name of the EDN file will match
+  the name of the immediate parent dir of source file. The EDN fill
+  is written to a directory.

-  The directory should only contain text files with a checksum and source
-  file name on each line. These files are produced with a shell script.
+  The input directory should only contain text files with a checksum
+  and source file name on each line. These files are produced separately
+  with a shell script.

   Notice that the nested paths are used to build an absolute URL to
-  the actual file. This is a consequence of the input checksum/source
-  not having the absolute path already, not a big deal, just something
-  we need to handle.
+  the actual file. This is needed because the input checksum/source
+  does not have an absolute path already; it must be deduced.

   The list of sources should be in directories like this:
-  - sites/california/H02V09-35/
-  - sites/california/H02V09-627/
-  - sites/california/H02V09-857/
+  - sites/california/H02V09-35/sources.txt
+  - sites/california/H02V09-627/sources.txt
+  - sites/california/H02V09-857/sources.txt
   - ...

   The list of outputs will be:
-  - outputs/H02V09-35.edn
-  - outputs/H02V09-627.edn
-  - outputs/H02V09-857.edn
+  - data/sources/california/H02V09-35.edn
+  - data/sources/california/H02V09-627.edn
+  - data/sources/california/H02V09-857.edn
   - ...
   "
   (def ^:dynamic *base-uri* "https://edclpdsftp.cr.usgs.gov/downloads/lcmap")
-  (let [files (dir->files "sites")
-        saver #(save-sources *base-uri* % "outputs")]
-    (map saver files)))
+  (let [files (dir->files "sites/lakes")
+        saver #(save-sources *base-uri* % "data/sources/lakes")]
+    (dorun (pmap saver files))))


Upgrade spyscore.

Upgrade spyscore.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,6 +1,6 @@
 {:user {:dependencies [[clj-stacktrace "0.2.5"]
                        [redl "0.1.0"]
-                       [spyscope "0.1.2"]
+                       [spyscope "0.1.3"]
                        [slamhound "1.3.3"]]
         :plugins [[lein-difftest "1.3.7"]
                   [lein-drip "0.1.1-SNAPSHOT"]


fix group create form

fix group create form

--- src/braid/ui/views/pages/group_explore.cljs
+++ src/braid/ui/views/pages/group_explore.cljs
@@ -1,22 +1,30 @@
 (ns braid.ui.views.pages.group-explore
-  (:require [chat.client.dispatcher :refer [dispatch!]])
+  (:require [reagent.core :as r]
+            [chat.client.dispatcher :refer [dispatch!]])
   (:import [goog.events KeyCodes]))

 (defn group-explore-page-view
   []
-  [:div.page.group-explore
-   [:div.title "Group Explore"]
-   [:div.content
-    [:p "One day, you'll be able to see various open groups that may be worth exploring here."]
+  (let [new-group-name (r/atom "")]
+    (fn []
+      [:div.page.group-explore
+       [:div.title "Group Explore"]
+       [:div.content
+        [:p "One day, you'll be able to see various open groups that may be worth exploring here."]

-    [:h2 "Create Group"]
-    [:div.new-group
-     [:label "New Group"
-      [:input {:placeholder "Group Name"
-               :on-keydown
-               (fn [e]
-                 (when (= KeyCodes.ENTER e.keyCode)
-                   (.preventDefault e)
-                   (let [group-name (.. e -target -value)]
-                     (dispatch! :create-group {:name group-name})
-                     (set! (.. e -target -value) ""))))}]]]]])
+        [:h2 "Create Group"]
+        [:div.new-group
+         [:label "New Group"
+          [:input {:placeholder "Group Name"
+                   :value @new-group-name
+                   :on-change (fn [e] (reset! new-group-name (.. e -target -value)))
+                   :on-keydown
+                   (fn [e]
+                     (when (= KeyCodes.ENTER e.keyCode)
+                       (.preventDefault e)
+                       (dispatch! :create-group {:name @new-group-name})
+                       (reset! new-group-name "")))}]
+          [:button {:on-click (fn [_]
+                                (dispatch! :create-group {:name @new-group-name})
+                                (reset! new-group-name ""))}
+           "Create"]]]]])))


working on facts->entities

working on facts->entities

--- sample/src/sample/core.clj
+++ sample/src/sample/core.clj
@@ -39,53 +39,79 @@
 ;;; (cltest1)

+
 (defn cltest2 []
   (cldb/db-rel fact e a v t)

-  (letfn [(entities [db]
-            (let [lres (cldb/with-db db
-                         (cl/run* [q]
-                           (cl/fresh [e a v t]
-                             (fact e a v t)
-                             (cl/== q [e a v t]))))]
-              (when (not-empty lres)
-                (reduce (fn [s [e a v t]]
-                          (update-in s [e a]
-                                     (fn [tmap]
-                                       (if tmap
-                                         (assoc tmap t v)
-                                         (sorted-map-by #(compare %2 %1) t v)))))
-                        {}
-                        lres))))]
+  (defn facts->entities [facts & {:keys [at-t]}]
+    (let [ldb (apply cldb/db facts)
+          lres (cldb/with-db ldb
+                 (cl/run* [q]
+                   (cl/fresh [e a v t]
+                     (fact e a v t)
+                     (cl/== q [e a v t]))))]
+      (when (not-empty lres)
+        (->> lres
+             (reduce (fn [s [e a v t]]
+                       (if (or (not at-t) (<= t at-t))
+                         (update-in s [e a]
+                                    (fn [[t2 v2 :as oldval]]
+                                      (if (and t2 (> t2 t))
+                                        oldval
+                                        [t v])))
+                         s))
+                     {})
+             ;;; TODO: this can probably be optimized in terms of memory usage & performance.
+             ;;;   instead of building a new map, can we somehow operate on the existing one?
+             (map (fn [[e am]]
+                    [e (reduce (fn [am [k [t v]]]
+                                 (assoc am k v))
+                               {}
+                               am)]))
+             (into {})))))

-    (let [facts1 (cldb/db
-                  [fact 200 :type     :address      1]
-                  [fact 200 :street   "street 111"  1]
-                  [fact 200 :number   111           1]
+  (defrecord Snapshot [state])

-                  [fact 100 :type     :person       2]
-                  [fact 100 :name     "foo"         2]
-                  [fact 100 :email    "foo@bar.com" 2]
-                  [fact 100 :address  200           2]
+  (defn snapshot [facts t]
+    )

-                  [fact 101 :type     :person       2]
-                  [fact 101 :name     "bar1"        2]
-                  [fact 101 :email    "bar@foo.com" 2]
-                  [fact 101 :address  200           2]
-                  [fact 101 :name     "bar2"        4]
-                  [fact 101 :name     "bar3"        3])]
+  (defrecord VersionedAttribute [m])

-      #_(cldb/with-db facts1
-        (cl/run* [q]
-          (cl/fresh [pid a v]
-            (fact pid :type :person (cl/lvar))
-            (fact pid :address 200 (cl/lvar))
-            (fact pid a v (cl/lvar))
-            (cl/== q [pid a v]))))
+  (let [facts1 [[fact 200 :type     :address      1]
+                [fact 200 :street   "street 111"  1]
+                [fact 200 :number   111           1]

-      (entities facts1))))
+                [fact 100 :type     :person       2]
+                [fact 100 :name     "foo"         2]
+                [fact 100 :email    "foo@bar.com" 2]
+                [fact 100 :address  200           2]
+
+                [fact 101 :type     :person       2]
+                [fact 101 :name     "bar1"        2]
+                [fact 101 :email    "bar@foo.com" 2]
+                [fact 101 :address  200           2]
+                [fact 101 :name     "bar3"        4]
+                [fact 101 :name     "bar5"        6]
+                [fact 101 :name     "bar2"        3]
+                [fact 101 :name     "bar4"        5]]]
+
+    (facts->entities facts1 :at-t 5)))

 ;;; (cltest2)
+
+
+
+(defn xftest []
+  (let [r (range 50000000)
+        f1 #(+ % %)
+        f2 dec
+        f3 #(* % 10)
+        ;;;s1 (doall (->> r (map f1) (map f2) (map f3)))
+        s2 (doall (sequence (comp (map f1) (map f2) (map f3)) r))
+        ]
+    (count s2)))
+
+;;; (xftest)


Make unit test run mode configurable.

Make unit test run mode configurable.

--- common-lib/src/cmr/common/test/runners/default.clj
+++ common-lib/src/cmr/common/test/runners/default.clj
@@ -14,6 +14,7 @@
   (:require
    [clojure.set :as set]
    [clojure.test :as t]
+   [cmr.common.config :refer [defconfig]]
    [cmr.common.dev.util :as du]
    [cmr.common.test.runners.util]
    [cmr.common.util :as u]
@@ -23,6 +24,11 @@
   [cmr.common.test.runners.util
    integration-test-namespaces
    unit-test-namespaces])
+
+(defconfig unit-test-parallel
+  "Indicates whether to run unit tests in parallel. Default to false for dev system to run stable."
+  {:type Boolean
+   :default false})

 (defn run-tests
   "Runs all the tests matching the list of namespace regular expressions. The tests are run
@@ -125,7 +131,7 @@
                                          (integration-test-namespaces))

         test-results-handler (fail-fast?->test-results-handler fail-fast?)
-        unittest-results (run-tests unit-test-namespaces false)
+        unittest-results (run-tests unit-test-namespaces (unit-test-parallel))
         inttest-results (run-tests integration-test-namespaces false)
         [took test-results] (u/time-execution
                               (test-results-handler


ideas

ideas

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -559,7 +559,7 @@
 ;; - Everything is done at compile time (and can be tested)
 ;; --------------------------------------------------------

-;; TODO - factorize the walks
+;; TODO - factorize the walks (start by showing this factoring)
 ;; TODO - optimize the expression

 (def computation-tree [+ :a [* :b :c]])


Cleanup

Cleanup

--- src/clojure/clojurewerkz/cassaforte/cql.clj
+++ src/clojure/clojurewerkz/cassaforte/cql.clj
@@ -136,12 +136,6 @@
   (cc/execute session
               (apply new-query-api/insert query-params)))

-(defn insert-async
-  "Same as insert but returns a future"
-  [^Session session & query-params]
-  (cc/async
-   (apply insert session query-params)))
-
 ;; (defn ^:private batch-query-from-
 ;;   [table records]
 ;;   (->> records
@@ -156,12 +150,6 @@
 ;;   (let [query-params (batch-query-from- table records)]
 ;;     (cc/execute session (q/batch-query query-params))))

-;; (defn insert-batch-async
-;;   "Same as insert-batch but returns a future"
-;;   [^Session session table records]
-;;   (cc/async
-;;    (insert-batch session table records)))
-
 ;; (defn atomic-batch
 ;;   "Executes a group of operations as an atomic batch (BEGIN BATCH ... APPLY BATCH)"
 ;;   [^Session session & clauses]
@@ -175,12 +163,6 @@
   [^Session session & query-params]
   (cc/execute session
               (apply new-query-api/update query-params)))
-
-(defn update-async
-  "Same as update but returns a future"
-  [^Session session & query-params]
-  (cc/async
-   (apply update session query-params)))

 (defn delete
   "Deletes columns and rows. If the `columns` clause is provided,
@@ -192,24 +174,12 @@
   (cc/execute session
               (apply new-query-api/delete (cons table query-params))))

-(defn delete-async
-  "Same as delete but returns a future"
-  [^Session session table & query-params]
-  (cc/async
-   (apply delete session table query-params)))
-
 (defn select
   "Retrieves one or more columns for one or more rows in a table.
    It returns a result set, where every row is a collection of columns returned by the query."
   [^Session session & query-params]
   (cc/execute session
               (apply new-query-api/select query-params)))
-
-(defn select-async
-  "Same as select but returns a future"
-  [^Session session & query-params]
-  (cc/async
-   (apply select session query-params)))

 (defn truncate
   "Truncates a table: permanently and irreversably removes all rows from the table,
@@ -273,31 +243,28 @@
 ;; Higher-level helper functions for schema
 ;;

-;; (defn describe-keyspace
-;;   "Returns a keyspace description, taken from `system.schema_keyspaces`."
-;;   [^Session session ks]
-;;   (assert (not cc/*prepared-statement*) "Describe Keyspace query can't be executed as a prepared query")
-;;   (first
-;;    (select session :system.schema_keyspaces
-;;            (q/where {:keyspace_name (name ks)}))))
-
-;; (defn describe-table
-;;   "Returns a table description, taken from `system.schema_columnfamilies`."
-;;   [^Session session ks table]
-;;   (assert (not cc/*prepared-statement*) "Describe Table query can't be executed as a prepared query")
-;;   (first
-;;    (select session :system.schema_columnfamilies
-;;            (q/where {:keyspace_name (name ks)
-;;                      :columnfamily_name (name table)}))))
-
-;; (defn describe-columns
-;;   "Returns table columns description, taken from `system.schema_columns`."
-;;   [^Session session ks table]
-;;   (assert (not cc/*prepared-statement*) "Describe Columns query can't be executed as a prepared query")
-;;   (select session :system.schema_columns
-;;           (q/where {:keyspace_name (name ks)
-;;                     :columnfamily_name (name table)})))
-
+(defn describe-keyspace
+  "Describes a keyspace"
+  [^Session session ks]
+  (first (select session
+                 (dsl/from :system :schema_keyspaces)
+                 (dsl/where {:keyspace_name (name ks)}))))
+
+(defn describe-table
+  "Describes a table"
+  [^Session session ks table]
+  (first (select session
+                 (dsl/from :system :schema_columnfamilies)
+                 (dsl/where {:columnfamily_name (name table)
+                             :keyspace_name     (name ks)}))))
+
+(defn describe-columns
+  "Describes a table"
+  [^Session session ks table]
+  (select session
+          (dsl/from :system :schema_columns)
+          (dsl/where {:columnfamily_name (name table)
+                      :keyspace_name     (name ks)})))
 ;;
 ;; Higher-level collection manipulation
 ;;


resolvents with tautology elimination

resolvents with tautology elimination

--- src/logic/resolution.clj
+++ src/logic/resolution.clj
@@ -2,7 +2,6 @@
  (:require [clojure.math.combinatorics :as combo])
  (:require [clojure.set :as set]))

-; how to handle clauses that are trivially true?
 (defn clause
   "Returns a clause of the distinct non-zero integers in coll,
    nil if the clause is trivially true."
@@ -15,6 +14,7 @@
           nil
           (recur (next in) (conj! result l)))))))

+; examples
 (clause '(-1 2 -3 -6))
 (clause (filter pos? (range 6)))
 (clause [1 2 3 -1])
@@ -28,18 +28,21 @@
   [cl-coll]
   (set cl-coll))

+; example
 (cl-set [(clause [1 2]) (clause [-1 2]) (clause [1 -2]) (clause [-1 -2])])

-; what about resolvents that are trivially true?
 (defn resolvents
-  "Returns the set of the resolvents of the clauses"
+  "Returns the set of the resolvents of the clauses,
+   ignoring tautologies, i.e. with tautlogy elimination."
   ([c1 c2]
-    (cl-set (map #(set (concat (disj c1 %) (disj c2 (- %))))
-                 (filter #(contains? c2 (- %)) c1))))
+    (cl-set (filter #(not (nil? %))
+                 (map #(clause (concat (disj c1 %) (disj c2 (- %))))
+                     (filter #(contains? c2 (- %)) c1)))))
   ([c1 c2 & more]
     (let [pairs (combo/combinations (cons c1 (cons c2 more)) 2)]
       (reduce set/union (map #(resolvents (first %) (second %)) pairs)))))

+; examples
 (resolvents (clause [1]) (clause [2 -1]))
 (resolvents (clause [1 -2]) (clause [2 -1]))
 (resolvents (clause [1]) (clause [-1]))


Show plugins directory in About tab

Show plugins directory in About tab

--- src/lt/objs/version.cljs
+++ src/lt/objs/version.cljs
@@ -38,6 +38,7 @@
                             [:dl
                              [:dt "Light Table version"] [:dd (:version deploy/version)]
                              [:dt "Binary version"] [:dd (deploy/binary-version)]
+                             [:dt "Plugins directory" [:dd (files/lt-user-dir "plugins")]]
                              ]
                             (check-button)
                             ]


Only attribute date in weekly digest.

Only attribute date in weekly digest.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -279,18 +279,21 @@
     (change-to)
     (tr-spacer 40)])

-(defn- post-attribution [publisher published-at]
-  [:tr
-    [:th {:class "small-1 large-1 first columns"}]
-    [:th {:class "small-10 large-10 columns"}
-      [:table
-        [:tr
-          [:th
-            [:p {:class "attribution"} (str (:name publisher) " on " (->> published-at
-                                                                        (format/parse iso-format)
-                                                                        (format/unparse attribution-format)))]]
-          [:th {:class "expander"}]]]]
-    [:th {:class "small-1 large-1 last columns"}]])
+(defn- post-attribution [publisher published-at frequency]
+  (let [attribution (if (= (keyword frequency) :daily)
+                      (:name publisher)
+                      (str (str (:name publisher) " on " (->> published-at
+                                                            (format/parse iso-format)
+                                                            (format/unparse attribution-format)))))]
+    [:tr
+      [:th {:class "small-1 large-1 first columns"}]
+      [:th {:class "small-10 large-10 columns"}
+        [:table
+          [:tr
+            [:th
+              [:p {:class "attribution"} attribution]]
+            [:th {:class "expander"}]]]]
+      [:th {:class "small-1 large-1 last columns"}]]))

 (defn- post-link [headline url]
   [:tr
@@ -316,20 +319,20 @@
           [:th {:class "expander"}]]]]
     [:th {:class "small-1 large-1 last columns"}]])

-(defn- post [data]
+(defn- post [data frequency]
   [:div
     (tr-spacer 27)
     (post-link (:headline data) (:url data))
     (tr-spacer 11)
-    (post-attribution (:publisher data) (:published-at data))])
-
-(defn- board [data]
+    (post-attribution (:publisher data) (:published-at data) frequency)])
+
+(defn- board [data frequency]
   [:table {:class "row board"}
     (tr-spacer 33)
     (board-name (:name data))
     (let [posts (:posts data)]
       (into [:div]
-        (map post posts)))
+        (map #(post % frequency) posts)))
     (tr-spacer 39)])

 (defn- digest-content [digest]
@@ -340,7 +343,7 @@
     (digest-banner (:digest-frequency digest))
     (let [boards (:boards digest)]
       (into [:div]
-        (map board boards)))
+        (map #(board % (:digest-frequency digest)) boards)))
     (digest-footer digest)])

 (defn- note


Fix labels separator interpose.

Fix labels separator interpose.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -354,11 +354,10 @@
                     [:td
                      [:div.oc-labels
                       [:span.oc-label-headline "Labels:"]
-                      (for [idx (range (count (:labels entry)))
-                            :let [label (get (:labels entry) idx)]]
-                        (list (label-block label)
-                              (when (-> entry :labels count (= idx) not)
-                                [:span.oc-label-separator])))]]])]]]]
+                      (for [label (interpose {:content-type :separator} (:labels entry))]
+                        (if (= (:content-type label) :separator)
+                          [:span.oc-label-separator]
+                          (label-block label)))]]])]]]]
             [:tr [:td
                 (spacer 8)]]]]]]))


Update server cl output.

Update server cl output.

--- src/open_company/app.clj
+++ src/open_company/app.clj
@@ -46,7 +46,7 @@
 (defn start [port]
   (run-server app {:port port :join? false})
   (println (str "\n" (slurp (clojure.java.io/resource "open_company/assets/ascii_art.txt")) "\n"
-    "API Server\n"
+    "OPENcompany API Server\n"
     "Running on port: " port "\n"
     "Database: " c/db-name "\n"
     "Database pool: " c/db-pool-size "\n"


fix UI inspect string display

fix UI inspect string display

this really needs an overhaul.

--- src/main/shadow/cljs/ui/worker/inspect.cljs
+++ src/main/shadow/cljs/ui/worker/inspect.cljs
@@ -68,12 +68,18 @@
         (assoc :ws-send [{:op :tap-subscribe :to from}])
         )))

-(defn guess-display-type [{:keys [db] :as env} {:keys [supports] :as summary}]
+(defn guess-display-type [{:keys [db] :as env} {:keys [data-type supports] :as summary}]
   (let [pref (get-in db [::m/ui-options :preferred-display-type])]
     (if (contains? supports pref)
       pref
-      (if (contains? supports :fragment)
+      (cond
+        (contains? supports :fragment)
         :browse
+
+        (contains? #{:string :number :boolean} data-type)
+        :str
+
+        :else
         :edn))))

 (defmethod relay-ws/handle-msg :tap-subscribed


Conti-2 porting LFE version of replace_txt_chunks.js to Clojure.

--- content/src/replace_txt_chunks.clj
+++ content/src/replace_txt_chunks.clj
@@ -24,6 +24,7 @@

 ; Helper constants.
 (defmacro EMPTY-STRING []     "")
+(defmacro SPACE        []    " ")
 (defmacro NEW-LINE     []   "\n")
 (defmacro DBG-PREF     [] "==> ")
 (defmacro SPACE-       []  #"\ ")
@@ -45,17 +46,17 @@
             (if (= word (last words)) (throw (Exception.  (str text- word)))
                                       (recur (rest words) (str text- (cond
                 (< (- pos 1) word-len)
-                    (let [word- (str (subs word (- pos 1)) subst
-                                     (subs word    pos  ))]
+                    (let [word- (str (subs word 0 (- pos 1)) subst
+                                     (subs word      pos  ))]

-;                   (println (str (DBG-PREF) word-))
+                    (println (str (DBG-PREF) word-))

                     word-)
-                :else
-;                   (println (str (DBG-PREF) word ))
+                :else (do
+                    (println (str (DBG-PREF) word ))

-                    word))))
-
+                    word))
+                (SPACE))))
         )))))
     (catch
         Exception e (.getMessage e)
@@ -72,7 +73,7 @@
 "evaluates to 'true'."
                      (EMPTY-STRING))]

-    (let [pos   3] ; <== Can be set to either from 1 to infinity.
+    (let [pos   7] ; <== Can be set to either from 1 to infinity.
 ;   (let [subst "callable entity"]
 ;   (let [subst "AAA"]
 ;   (let [subst "+-="]


don't cache js file

don't cache js file

--- src/pc/views/content.clj
+++ src/pc/views/content.clj
@@ -27,7 +27,7 @@
    (if (= (System/getenv "PRODUCTION") "true")
      (list
       [:script {:type "text/javascript" :src "/js/vendor/react-0.10.0.js"}]
-      [:script {:type "text/javascript" :src "/cljs/production/frontend.js"}])
+      [:script {:type "text/javascript" :src (str "/cljs/production/frontend.js?rand=" (Math/random))}])
      (if false
        [:script {:type "text/javascript" :src "/js/bin-debug/main.js"}]
        (list


Ensure examples have the right deps.

Ensure examples have the right deps.

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -2,7 +2,7 @@
   :dependencies [[org.clojure/clojure        "1.8.0"]
                  [org.clojure/clojurescript  "1.9.89"]
                  [reagent "0.6.0-rc"]
-                 [re-frame "0.8.0-SNAPSHOT"]
+                 [re-frame "0.8.0"]
                  [binaryage/devtools "0.8.1"]
                  [secretary "1.2.3"]]


Fix nested escaping of strings

Fix nested escaping of strings

--- src/riemann/influxdb.clj
+++ src/riemann/influxdb.clj
@@ -21,7 +21,7 @@
   (clojure.string/join "," (map
     (fn [[key value]]
       (if (instance? String value)
-        (str (replace-disallowed-9 key) "=" (str "\"" (str/escape value {\" "\\\""}) "\""))
+        (str (replace-disallowed-9 key) "=" (pr-str value))
         (str (replace-disallowed-9 key) "=" (clojure.pprint/cl-format nil "~F" value))))
     kv)))


clojure.string is no more required

clojure.string is no more required

--- src/riemann/influxdb.clj
+++ src/riemann/influxdb.clj
@@ -1,7 +1,6 @@
 (ns riemann.influxdb
   "Forwards events to InfluxDB"
-  (:require [capacitor.core :as influx])
-  (:use [clojure.string :only [split join]]))
+  (:require [capacitor.core :as influx]))

 (defn influxdb
   "Returns a function which accepts an event and sends it to InfluxDB.


Housekeeping

Housekeeping

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -75,6 +75,7 @@
   "Joins parts to form an idiomatic compound Redis key name. Suggested style:
     * \"category:subcategory:id:field\" basic form.
     * Singular category names (\"account\" rather than \"accounts\").
+    * Plural _field_ names when appropriate (\"account:friends\").
     * Dashes for long names (\"email-address\" rather than \"emailAddress\", etc.)."
   [& parts] (str/join ":" (mapv utils/keyname parts)))


Intervals, leaps, steps, octaves et al

Intervals, leaps, steps, octaves et al

--- src/tenor/constructs.clj
+++ src/tenor/constructs.clj
@@ -90,12 +90,53 @@
                        :running-string running-string
                        :running-count running-count))))

-;; --- Musical piece --- ;;;
+;; --- Intervals --- ;;

-(defn map-entity [entity scale]
+(defn up-step [degree] (inc degree))
+(defn down-step [degree] (dec degree))
+(defn up-leap [degree] (+ (rand-nth [2 3 4 5]) degree))
+(defn down-leap [degree] (- (rand-nth [2 3 4 5]) degree))
+(defn up-octave [degree] (+ 7 degree))
+(defn down-octave [degree] (- 7 degree))
+
+(defn make-move [scale degree]
+  (let [movements '(up-step down-step up-leap down-leap up-octave down-octave)
+        current-move (weighted-choose movements '(0.35 0.35 0.1 0.1 0.05 0.05))
+        temp-degree ((resolve current-move) degree)]
+    (if (and (> temp-degree 0) (>= (count scale) temp-degree))
+      temp-degree
+      (make-move scale temp-degree))))
+
+(defn construct-intervals [scale note-count
+                           & {:keys [running-interval degree]
+                              :or {running-interval '()
+                                   degree 1}}]
+  (if (<= note-count 0)
+    running-interval
+    (let [degree (make-move scale degree)
+          running-interval (concat running-interval (list degree))
+          note-count (dec note-count)]
+      (construct-intervals scale
+                           note-count
+                           :degree degree
+                           :running-interval running-interval))))
+
+(defn generate-intervals [scale note-count]
+  (let [mid-intervals (construct-intervals scale (- note-count 2))
+        scale-count (count scale)]
+    (concat '(1)
+            mid-intervals
+            (list (rand-nth `(1 ~scale-count))))))
+
+(defn intervals->notes [intervals scale]
+  (map #(nth scale (dec %)) intervals))
+
+;; --- Musical piece --- ;;
+
+(defn map-entity [entity intervals]
   "Create a list of hash-maps of positions as keys
   and musical notes as values."
-  (map #(hash-map :pos %, :note (rand-nth scale)) entity))
+  (map #(hash-map :pos %1, :note %2) entity intervals))

 (defn generate-piece [measure-count note-count note-value sparseness]
   "Generate a musical piece with measure-count measures,
@@ -112,9 +153,10 @@
                                     scale (generate-random-scale)}}]
   "Take measure count,note count and note value, and generate a
   measure map using map-entity."
-  (map-entity
-    (generate-piece measure-count note-count note-value sparseness)
-    scale))
+  (let [piece (generate-piece measure-count note-count note-value sparseness)
+        scale-intervals (intervals->notes
+                          (generate-intervals scale (count piece)) scale)]
+  (map-entity piece scale-intervals)))

 ;; --- Playback --- ;;


include transit-cljs write time for seattle data

--- bench/transit/bench.cljs
+++ bench/transit/bench.cljs
@@ -7,6 +7,7 @@
 (def fs (js/require "fs"))
 (def json (. fs (readFileSync "../transit/seattle-data0.tjs" "utf8")))
 (def r (t/reader :json))
+(def w (t/writer :json))

 (println "100 iters, transit read seattle file")
 (println (. r (read json)))
@@ -19,8 +20,14 @@
   (dotimes [_ 100]
     (.parse js/JSON json)))

+(println "100 iters, transit write seattle file")
+(let [seattle (. r (read json))]
+  (time
+    (dotimes [_ 100]
+      (.write w seattle))))
+
 (println "10 iters, cljs.reader/read-string seattle file")
-(def edn (pr-str (. r (read json))))
+(def edn (pr-str (.read r json)))
 (time
   (dotimes [_ 10]
     (r/read-string edn)))


Add :builtin/rect rendering.

Add :builtin/rect rendering.

--- src/uxbox/ui/shapes.cljs
+++ src/uxbox/ui/shapes.cljs
@@ -38,6 +38,19 @@
     (html
      [:g attrs data])))

+(defmethod shapes/-render :builtin/rect
+  [{:keys [id view-box] :as shape} _]
+  (let [key (str id)
+        rfm (svg/calculate-transform shape)
+        attrs (merge {:width (nth view-box 2)
+                      :height (nth view-box 3)
+                      :x 0 :y 0}
+                     (extract-attrs shape)
+                     (make-debug-attrs shape))]
+    (html
+     [:g {:id key :key key :transform rfm}
+      [:rect attrs]])))
+
 (defmethod shapes/-render :builtin/group
   [{:keys [items id] :as shape} factory]
   (let [key (str "group-" id)
@@ -54,14 +67,29 @@
             (rum/with-key (str (:id item)))))])))

 (defmethod shapes/-render-svg :builtin/icon
-  [{:keys [data id view-box] :as shape} attrs]
+  [{:keys [data id view-box] :as shape}]
   (let [key (str "icon-svg-" id)
         view-box (apply str (interpose " " view-box))
         props {:view-box view-box :id key :key key}
         attrs (-> shape
                   (extract-attrs)
                   (remove-nil-vals)
-                  (merge attrs props))]
+                  (merge props))]
     (html
      [:svg attrs data])))

+
+(defmethod shapes/-render-svg :builtin/rect
+  [{:keys [id view-box] :as shape}]
+  (let [key (str "icon-svg-" id)
+        view (apply str (interpose " " view-box))
+        props {:view-box view :id key :key key}
+        attrs (merge {:width (nth view-box 2)
+                      :height (nth view-box 3)
+                      :x 0 :y 0}
+                     (extract-attrs shape)
+                     (make-debug-attrs shape))]
+    (html
+     [:svg props
+      [:rect attrs]])))
+


Increase time delta in tests.

Increase time delta in tests.

--- test/dsbdp/test/experiment_helper_tests.clj
+++ test/dsbdp/test/experiment_helper_tests.clj
@@ -89,7 +89,7 @@
         end-time (System/nanoTime)
         time-delta (- end-time start-time)]
     (is (> time-delta 100000))
-    (is (< time-delta 150000))
+    (is (< time-delta 200000))
     ))

 (deftest busy-sleep-test-2
@@ -98,7 +98,7 @@
         end-time (System/nanoTime)
         time-delta (- end-time start-time)]
     (is (> time-delta 1000000))
-    (is (< time-delta 1050000))
+    (is (< time-delta 1200000))
     ))

 (deftest busy-sleep-proc-fns-test-1


Define postgres settings using environment vars

In the past we were copying a magic from from tb-driver: local.clj that
contained all the information needed to connect to our test Postgres
database. tb-driver is being decommissioned, and its felt we need a better
way to manage this going forward.

This patch allows us to parameterize database tests, in particular the postgres
specific settings using environment variables. This way we can pass the
settings in from Jenkins using its special 'passwords as environment vars'
feature.

The default HSQLDB behaviour is kept if DBTEST_TYPE is not set, and local.clj
support is kept.

Signed-off-by: Ken Barber <470bc578162732ac7f9d387d34c4af4ca6e1b6f7@bob.sh>

--- test-resources/config/default.clj
+++ test-resources/config/default.clj
@@ -7,11 +7,25 @@
 (defn test-db-config
   "Return a map of connection attrs for the test database"
   []
-  {:classname   "org.hsqldb.jdbcDriver"
-   :subprotocol "hsqldb"
-   :subname     (str "mem:"
-                  (java.util.UUID/randomUUID)
-                  ";shutdown=true;hsqldb.tx=mvcc;sql.syntax_pgs=true")})
+  (let [dbtype     (System/getenv "PUPPETDB_DBTYPE")
+        dbsubname  (System/getenv "PUPPETDB_DBSUBNAME")
+        dbuser     (System/getenv "PUPPETDB_DBUSER")
+        dbpassword (System/getenv "PUPPETDB_DBPASSWORD")]
+    (if (= dbtype "postgres")
+      (if (some nil? [dbsubname dbuser dbpassword])
+        (do
+          (println "Ensure environment variables PUPPETDB_DBSUBNAME, PUPPETDB_DBUSER and PUPPETDB_DBPASSWORD are set")
+          (System/exit 1))
+        {:classname   "org.postgresql.Driver"
+         :subprotocol "postgresql"
+         :subname     dbsubname
+         :user        dbuser
+         :password    dbpassword})
+      {:classname   "org.hsqldb.jdbcDriver"
+       :subprotocol "hsqldb"
+       :subname     (str "mem:"
+                      (java.util.UUID/randomUUID)
+                      ";shutdown=true;hsqldb.tx=mvcc;sql.syntax_pgs=true")})))

 ;; here is a sample test-db-config function for use with postgres
 ;(defn test-db-config


Project Manager and above can see users tab.

--- src-cljs/kixi/hecuba/menu.cljs
+++ src-cljs/kixi/hecuba/menu.cljs
@@ -9,7 +9,10 @@
                                {:pathname "/search" :text "Search"}
                                {:pathname "/properties_comparison" :text "Compare"}
                                {:pathname "/property_map" :text "Property Map"}
-                               ;; {:pathname "/user" :text "User Management" :only-roles [:kixi.hecuba.security/super-admin]}
+                               {:pathname "/user" :text "User Management" :only-roles ["super-admin"
+                                                                                "admin"
+                                                                                "programme-manager"
+                                                                                "project-manager"]}
                                {:pathname "/logout" :text "Logout"}
                                {:pathname "https://github.com/MastodonC/kixi.hecuba/blob/master/doc/documentation.md" :text "Documentation"}]
                        :whoami nil}))
@@ -21,11 +24,14 @@
       (html
        [:div
         [:ul {:class "nav navbar-nav"}
-         (for [{:keys [pathname text roles]} menu
+         (for [{:keys [pathname text only-roles]} menu
                :let [current-page? (= page-pathname pathname)
                      href (if current-page? "#" pathname)
-                     opts (when current-page? {:class "active"})]]
-           [:li opts [:a {:href href} text]])]
+                     opts (when current-page? {:class "active"})
+                     role (:role whoami)]]
+           (when (or (not only-roles)
+                   (some (into #{} only-roles) #{role}))
+             [:li opts [:a {:href href} text]]))]
         [:div.pull-right {:id :whoami} (slugs/slugify-whoami whoami)]]))))


swagger works now

swagger works now

--- test/cljc/reitit/swagger_test.clj
+++ test/cljc/reitit/swagger_test.clj
@@ -59,7 +59,25 @@
                          :uri "/api/swagger.json"}))]
       (is (= {:x-id ::math
               :info {:title "my-api"}
-              :paths {"/api/schema/plus" {:get {:summary "plus"}} ;; TODO: implement!
+              :paths {"/api/schema/plus" {:get {:parameters [{:description ""
+                                                              :format "int32"
+                                                              :in "query"
+                                                              :name "x"
+                                                              :required true
+                                                              :type "integer"}
+                                                             {:description ""
+                                                              :format "int32"
+                                                              :in "query"
+                                                              :name "y"
+                                                              :required true
+                                                              :type "integer"}]
+                                                :responses {200 {:description ""
+                                                                 :schema {:additionalProperties false
+                                                                          :properties {"total" {:format "int32"
+                                                                                :type "integer"}}
+                                                                          :required ["total"]
+                                                                          :type "object"}}}
+                                                :summary "plus"}}
                       "/api/spec/plus" {:get {:parameters [{:description ""
                                                             :format "int64"
                                                             :in "query"


Migrate during test fixtures.

Migrate during test fixtures.

--- test/clojars/test/test_helper.clj
+++ test/clojars/test/test_helper.clj
@@ -1,9 +1,11 @@
 (ns clojars.test.test-helper
   (import java.io.File)
   (:require [clojars.db :as db]
+            [clojars.db.migrate :as migrate]
             [clojars.config :as config]
             [korma.db :as kdb]
             [clojure.test :as test]
+            [clojure.java.shell :as sh]
             [clojure.java.io :as io]
             [clojure.java.jdbc :as jdbc]))

@@ -22,9 +24,18 @@
           (delete-file-recursively child)))
       (io/delete-file f))))

+(defonce migrate
+  (delay
+   (let [db (:subname (:db config/config))]
+     (when-not (.exists (io/file db))
+       (.mkdirs (.getParentFile (io/file db)))
+       (sh/sh "sqlite3" db :in (slurp "clojars.sql"))))
+   (migrate/-main)))
+
 (defn use-fixtures []
   (test/use-fixtures :each
                      (fn [f]
+                       (force migrate)
                        (let [file (File. (:repo config/config))]
                          (delete-file-recursively file))
                        (f)


add sync in webhooks

add sync in webhooks

--- src/blog_clj/webhooks.clj
+++ src/blog_clj/webhooks.clj
@@ -1,7 +1,9 @@
 (ns blog-clj.webhooks
   (:require [pandect.algo.sha1 :refer [sha1-hmac]]
             [clojure.edn :as edn]
-            [ring.util.response :refer [status response]]))
+            [ring.util.response :refer [status response]]
+            [clojure.java.shell :refer [sh]]
+            [blog-clj.sync :refer [sync-blogs]]))

 (def config (edn/read-string (slurp "config.clj")))

@@ -15,7 +17,10 @@
     (cond
       (and (= hmac signature)
            (= event-type "push"))
-      "A push event received!"
+      (do
+        (sh "git" "pull" :dir (:html-path config))
+        (sync-blogs)
+        "A push event received!")
       (and (= hmac signature)
            (not= event-type "push"))
       (format "Event %s received!" event-type)