add missing module-loaded calls for react-native

hot-reload check fails otherwise thinking no code is loaded

--- src/main/shadow/build/targets/react_native.clj
+++ src/main/shadow/build/targets/react_native.clj
@@ -76,7 +76,19 @@
     modules
     chunks))

-(defn configure [state mode {:keys [chunks init-fn output-dir] :as config}]
+(defn prepend-str [a b]
+  (str b a))
+
+(defn add-module-loaded-calls [modules]
+  (reduce-kv
+    (fn [m module-id module]
+      (update-in m [module-id :append-js]
+        prepend-str (str "\nshadow.cljs.devtools.client.env.module_loaded('" (name module-id) "');\n")))
+    modules
+    modules))
+
+(defn configure
+  [{:keys [worker-info] :as state} mode {:keys [chunks init-fn output-dir] :as config}]
   (let [output-dir
         (io/file output-dir)

@@ -85,6 +97,12 @@

         dev?
         (= :dev mode)
+
+        enabled?
+        (not (false? (get-in config [:devtools :enabled])))
+
+        build-worker?
+        (and enabled? (= :dev mode) worker-info)

         modules
         (-> {:index {:entries [(output/ns-only init-fn)]
@@ -92,7 +110,10 @@
             (cond->
               (seq chunks)
               (-> (update :index assoc :prepend "var $APP = global.$APP = {};\n")
-                  (add-chunk-modules mode chunks))))]
+                  (add-chunk-modules mode chunks))
+
+              build-worker?
+              (add-module-loaded-calls)))]

     (io/make-parents output-file)


support selective backend num

support selective backend num

--- src/clj/dokkaa_builder/apps.clj
+++ src/clj/dokkaa_builder/apps.clj
@@ -33,10 +33,12 @@

 (defn- pick-backends
   "Randomly choose docker backend"
-  []
+  [n]
   (mapv (fn [ip] {:client (docker/make-client (str ip ":4243"))
                   :port   (router/generate-host-port ip)})
-        (cluster-ips)))
+        (->> (cluster-ips)
+             shuffle
+             (take n))))

 (defn- default-frontend-url [app-name]
   (str app-name "." (config/domain-name)))
@@ -51,7 +53,7 @@
     (:instances app)))

 (defn create [app-name user image & {:keys [tag command port]}]
-  (let [backends (pick-backends)
+  (let [backends (pick-backends 1)
         front-url (default-frontend-url app-name)
         old-isntances (instances app-name)
         new-instances (vec (for [{cli :client host-port :port} backends]
@@ -89,7 +91,7 @@
       (container/remove cli id))))

 (defn logs [app-name user]
-  (let [{cli :client} (first (pick-backends))
+  (let [{cli :client} (first (pick-backends 1))
         resp (container/logs cli (-> app-name instances first :id) :stdout true :stderr true)]
     (map #(str (name (:stream-type %))
                ": "


subject-verb agreement in Djinn message

subject-verb agreement in Djinn message

fixes #1401

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -156,7 +156,7 @@
    "Djinn"
    {:abilities [{:label "Search your Stack for a virus program and add it to your Grip"
                  :prompt "Choose a Virus"
-                 :msg (msg "adds " (:title target) " to their Grip")
+                 :msg (msg "add " (:title target) " to their Grip")
                  :choices (req (cancellable (filter #(and (is-type? % "Program")
                                                           (has-subtype? % "Virus"))
                                                     (:deck runner)) :sorted))


adding example calls for memory db

adding example calls for memory db

--- src/clj/ow/factum/db/memory.clj
+++ src/clj/ow/factum/db/memory.clj
@@ -6,7 +6,9 @@
   d/Eventstore

   (get-all [this]
-    @facts)
+    (->> @facts
+         (sort-by #(nth % 3))
+         reverse))

   (new-eid [this]
     (swap! cureid inc))
@@ -21,5 +23,27 @@
       (swap! facts #(conj % (conj ifact (or action :add))))
       ifact)))

-(defn new-eventstore [facts]
-  (->Eventstore (atom facts) (atom -1) (atom -1)))
+(defn new-eventstore []
+  (->Eventstore (atom '()) (atom -1) (atom -1)))
+
+
+
+(comment (def es (new-eventstore))
+
+         (d/add-facts es [[1 :name "walter1"] [1 :birthday #inst"1980-01-01"]])
+
+         (d/add-facts es [[1 :name "walter2"] [1 :birthday #inst"1981-01-01"]])
+
+         (d/add-facts es [[1 :name "walter3"] [1 :birthday #inst"1982-01-01"]])
+
+         (d/add-facts es [[1 :name "walter4"]])
+
+         (def ldb (ow.factum.logic/get-logic-db es))
+
+         (clojure.core.logic.pldb/with-db ldb
+           (clojure.core.logic/run* [q]
+             (clojure.core.logic/fresh [e a v]
+               (ow.factum.logic/fact e a v (clojure.core.logic/lvar))
+               (clojure.core.logic/== q [a v]))))
+
+         )


Add bug notes/FIXMEs in spec.lang

Add bug notes/FIXMEs in spec.lang

--- src/cljc/precept/spec/lang.cljc
+++ src/cljc/precept/spec/lang.cljc
@@ -28,6 +28,9 @@
   (s/or :tuple-1-keyword (s/tuple keyword?)
         :keyword keyword?))

+;; FIXME. Does not appear to pass for a full accumulator condition, though
+;; will match the portion that uniquely identifies an accumulator. Create a spec for
+;; the full accumulator syntax to avoid confusion
 (s/def ::accum-expr
   (s/cat :accum-fn ::s-expr
          :from-symbol #{'from :from}
@@ -54,7 +57,8 @@
   (s/tuple
     (s/and some? #(not (s/valid? ::s-expr %)))
     any?))
-
+;;FIXME. sexprs are allowed in 3rd slot. A variable binding in :e passes when sexpr in :v,
+;; but the production is wrong when a keyword or value is in :e and sexpr in :v
 (s/def ::tuple-3
   (s/tuple
     (s/and some? #(not (s/valid? ::s-expr %)))


don't destructure, it's slower

don't destructure, it's slower

--- src/cheshire/generate.clj
+++ src/cheshire/generate.clj
@@ -42,11 +42,13 @@
 (definline generate-map [^JsonGenerator jg obj ^String date-format ^Exception e]
   `(do
      (.writeStartObject ~jg)
-     (doseq [[k# v#] ~obj]
-       (.writeFieldName ~jg (if (keyword? k#)
-                              (.substring (str k#) 1)
-                              (str k#)))
-       (generate ~jg v# ~date-format ~e))
+     (doseq [m# ~obj]
+       (let [k# (key m#)
+             v# (val m#)]
+         (.writeFieldName ~jg (if (keyword? k#)
+                                (.substring (str k#) 1)
+                                (str k#)))
+         (generate ~jg v# ~date-format ~e)))
      (.writeEndObject ~jg)))

 (definline generate-array [^JsonGenerator jg obj ^String date-format


REPL!

REPL!

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -9,7 +9,7 @@
 (set! *warn-on-reflection* true)

 (ns cljs.compiler
-  (:refer-clojure :exclude [munge])
+  (:refer-clojure :exclude [munge load-file])
   (:require [clojure.java.io :as io]))

 (declare resolve-var)
@@ -35,9 +35,11 @@
 ;;todo - move to core.cljs, using js
 (def ^String bootjs "
 //goog.provide should do this for us
-cljs = {}
-cljs.core = {}
-cljs.user = {}
+//cljs = {}
+//cljs.core = {}
+//cljs.user = {}
+goog.provide('cljs.core');
+goog.provide('cljs.user');
 cljs.core.truth_ = function(x){return x != null && x !== false;}
 cljs.core.fnOf_ = function(f){return (f instanceof Function?f:f.cljs$core$Fn$invoke);}")

@@ -493,6 +495,38 @@
         (and (seq? form) (seq form)) (analyze-seq env form name)
         :else {:op :constant :env env :form form}))))

+(defn eval1
+  [^javax.script.ScriptEngine jse env form]
+  (try
+    (let [ast (analyze env form)
+          js (emits ast)]
+      (try
+        (let [ret (.eval jse js)]
+          ret)
+        (catch Throwable ex
+          ;;we eat ns errors because we know goog.provide() will throw when reloaded
+          ;;TODO - file bug with google, this is bs error
+          ;;this is what you get when you try to 'teach new developers' via errors (goog/base.js 104)
+          (when-not (and (seq? form) (= 'ns (first form)))
+            (prn "Error evaluating:" form :as js)
+            (println (str ex))))))
+    (catch Throwable ex
+      (println (str ex)))))
+
+(defn load-file
+  [jse f]
+  (binding [*cljs-ns* 'cljs.user]
+    (let [env {:ns (@namespaces *cljs-ns*) :context :statement :locals {}}
+          res (if (= \/ (first f)) f (io/resource f))]
+      (assert res (str "Can't find " f " in classpath"))
+      (with-open [r (io/reader res)]
+        (let [pbr (clojure.lang.LineNumberingPushbackReader. r)
+              eof (Object.)]
+          (loop [r (read pbr false eof false)]
+            (when-not (identical? eof r)
+              (eval1 jse env r)
+              (recur (read pbr false eof false)))))))))
+
 (defn repl-env
   "Returns a fresh JS environment, suitable for passing to repl.
   Hang on to return for use across repl calls."
@@ -500,16 +534,20 @@
   (let [jse (-> (javax.script.ScriptEngineManager.) (.getEngineByName "JavaScript"))
         base (io/resource "goog/base.js")]
     (assert base "Can't find goog/base.js in classpath")
+    (.put jse javax.script.ScriptEngine/FILENAME "goog/base.js")
     (with-open [r (io/reader base)]
       (.eval jse r))
     (.eval jse bootjs)
     {:jse jse}))

 (defn repl
+  "Note - repl will reload core.cljs every time, even if supplied old repl-env"
   [repl-env]
   (prn "Type: " :cljs/quit " to quit")
   (binding [*cljs-ns* 'cljs.user]
-    (let [env {:context :statement :locals {}}]
+    (let [jse (:jse repl-env)
+          env {:context :statement :locals {}}]
+      (load-file (:jse repl-env) "cljs/core.cljs")
       (loop []
         (print (str "ClojureScript:" *cljs-ns* "> "))
         (flush)
@@ -518,25 +556,28 @@
            (= form :cljs/quit) :quit

            (and (seq? form) (= (first form) 'in-ns))
-           (do (set! *cljs-ns* (second (second form))) (recur))
-
+           (do (set! *cljs-ns* (second (second form))) (newline) (recur))
+
+           (and (seq? form) ('#{load-file clojure.core/load-file} (first form)))
+           (do (load-file jse (second form)) (newline) (recur))
+
            :else
-           (let [ret (try
-                       (let [ast (analyze (assoc env :ns (@namespaces *cljs-ns*)) form)
-                             js (emits ast)
-                             ret (.eval ^javax.script.ScriptEngine (:jse repl-env) js)]
-                         ret)
-                       (catch Throwable ex
-                         (.printStackTrace ex)))]
+           (let [ret (eval1 jse (assoc env :ns (@namespaces *cljs-ns*)) form)]
              (prn ret)
              (recur))))))))

 (comment

+;;the new way - use the REPL!!
 (require '[cljs.compiler :as comp])
 (def jse (comp/repl-env))
 (comp/repl jse)
-
+(+ 1 2)
+(in-ns 'cljs.core)
+;;hack on core
+
+
+;;OLD way, don't you want to use the REPL?
 (in-ns 'cljs.compiler)
 (import '[javax.script ScriptEngineManager])
 (def jse (-> (ScriptEngineManager.) (.getEngineByName "JavaScript")))


remove code dup

remove code dup

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -116,9 +116,6 @@
                (swap! *cljs-gen-col* (fn [col] (+ col (count s)))))
              (print s))))
   nil)
-
-(defn ^String emit-str [expr]
-  (with-out-str (emit expr)))

 (defn emitln [& xs]
   (apply emits xs)


Rewrite instant, duration and period using protocols.

--- src/clj/guangyin/core.clj
+++ src/clj/guangyin/core.clj
@@ -7,41 +7,156 @@
                       MonthDay OffsetDateTime OffsetTime Period Year YearMonth
                       ZonedDateTime ZoneId ZoneOffset DayOfWeek Month)))

-(defn instant?
-  "Returns true if the given value is an instant.
-   Examples:
-
-    => (instant? (instant))
-    true
-    => (instant? (days 1))
-    false"
-  [x] (wrapped-instance? Instant x))
-
-(defn duration?
-  "Returns true if the given value is a duration.
-   Duration refers to an exact length of time that can be converted accurately
-   to seconds without any time zone information, basically any length of time
-   that is measured in hours or smaller units than that.
-   Examples:
-
-     => (duration? (hours 1))
+(defprotocol IInstant
+  (instant? [this]
+   "Returns true if the given value is an instant.
+    Examples:
+
+     => (instant? (instant))
      true
-     => (duration? (days 1))
-     false"
-  [x] (wrapped-instance? Duration x))
-
-(defn period?
-  "Returns true if the given value is a period.
-   Period refers to a length of time that can not be converted accurately to
-   seconds without any time zone information, basically any length of time that
-   is measured in days or larger units than that.
-   Examples:
-
-     => (period? (weeks 1))
-     true
-     => (period? (minutes 30))
-     false"
-  [x] (wrapped-instance? Period x))
+     => (instant? (days 1))
+     false")
+  (instant [this]
+   "Coerce to instant.
+    Examples:
+
+      => (instant :now) ; Current instant
+      #<Instant 2015-01-01T12:15:00.123Z>
+      => (instant (clock)) ; Current instant from clock
+      #<Instant 2015-01-01T12:15:00.123Z>
+      => (instant \"2015-01-01T12:15:00.123Z\")
+      #<Instant 2015-01-01T12:15:00.123Z>
+      => (instant :epoch)
+      #<Instant 1970-01-01T00:00:00Z>
+      => (instant (offset-date-time)) ; From date-time containing instant
+      #<Instant 2015-01-01T12:15:00.123Z>"))
+
+(extend-protocol IInstant
+  guangyin.internal.types.ObjectWrapper
+  (instant? [this] (instant? @this))
+  (instant [this] (instant @this))
+  clojure.lang.Keyword
+  (instant? [this] false)
+  (instant [this] (if (= this :now)
+                      (wrap (Instant/now))
+                      (wrap (fields/instants this))))
+  java.time.temporal.TemporalAccessor
+  (instant? [this] (instance? Instant this))
+  (instant [this] (wrap (Instant/from this)))
+  java.time.Clock
+  (instant? [this] false)
+  (instant [this] (wrap (Instant/now this)))
+  java.lang.String
+  (instant? [this] false)
+  (instant [this] (wrap (Instant/parse this)))
+  java.lang.Object
+  (instant? [this] false))
+
+(defprotocol IDuration
+  (duration? [this]
+   "Returns true if the given value is a duration.
+    Duration refers to an exact length of time that can be converted accurately
+    to seconds without any time zone information, basically any length of time
+    that is measured in hours or smaller units than that.
+    Examples:
+
+      => (duration? (hours 1))
+      true
+      => (duration? (days 1))
+      false")
+  (duration [this] [this other]
+   "Coerce to duration.
+    Notice that duration is only for exact times, if you are working with dates
+    you most likely want to use a period instead. Can also be used to create a
+    duration from start and end times. See also functions hours, minutes,
+    seconds and nanos, they all return a duration.
+    Examples:
+
+      => (duration \"P2D\") ; 2 days is converted to 48 hours
+      #<Duration PT48H>
+      => (duration \"PT15M\") ; 15 minutes
+      #<Duration PT15M>
+      => (duration \"PT-6H3M\") ; -6 hours and +3 minutes
+      #<Duration PT-5H-57M>
+      => (duration \"-PT6H3M\") ; -6 hours and -3 minutes
+      #<Duration PT-6H-3M>
+      => (duration (instant :epoch) (instant \"2015-01-01T12:15:00.123Z\"))
+      #<Duration PT394476H15M0.123S>
+      => (duration (local-time :midnight) (local-time :noon))
+      #<Duration PT12H>"))
+
+(extend-protocol IDuration
+  guangyin.internal.types.ObjectWrapper
+  (duration? [this] (duration? @this))
+  (duration [this] (duration @this))
+  (duration [this other] (duration @this (unwrap other)))
+  clojure.lang.Keyword
+  (duration? [this] false)
+  (duration [this] (wrap (fields/durations this)))
+  java.time.temporal.Temporal
+  (duration? [this] false)
+  (duration [this other] (wrap (Duration/between this other)))
+  java.time.temporal.TemporalAmount
+  (duration? [this] (instance? Duration this))
+  (duration [this] (wrap (Duration/from this)))
+  java.lang.String
+  (duration? [this] false)
+  (duration [this] (wrap (Duration/parse this)))
+  java.lang.Object
+  (duration? [this] false))
+
+(defprotocol IPeriod
+  (period? [this]
+   "Returns true if the given value is a period.
+    Period refers to a length of time that can not be converted accurately to
+    seconds without any time zone information, basically any length of time that
+    is measured in days or larger units than that.
+    Examples:
+
+      => (period? (weeks 1))
+      true
+      => (period? (minutes 30))
+      false")
+  (period [this] [this other]
+   "Coerce to period.
+    Notice that period is only for days and larger time units. If you want to
+    work with time you should use duration instead. Can also be used to create a
+    period from start and end date. See also functions years, months, weeks and
+    days, they all return a period.
+    Examples:
+
+      => (period \"P2Y\")
+      #<Period P2Y>
+      => (period \"P1Y2M3W4D\")
+      #<Period P1Y2M25D>
+      => (period \"P-1Y2M\")
+      #<Period P-1Y2M>
+      => (period \"-P1Y2M\")
+      #<Period P-1Y-2M>
+      => (period :zero)
+      #<Period P0D>
+      => (period (local-date \"2015-01-01\") (local-date \"2017-04-12\"))
+      #<Period P2Y3M11D>"))
+
+(extend-protocol IPeriod
+  guangyin.internal.types.ObjectWrapper
+  (period? [this] (period? @this))
+  (period [this] (period @this))
+  (period [this other] (period @this (unwrap other)))
+  clojure.lang.Keyword
+  (period? [this] false)
+  (period [this] (wrap (fields/periods this)))
+  java.time.temporal.TemporalAmount
+  (period? [this] (instance? Period this))
+  (period [this] (wrap (Period/from this)))
+  java.time.LocalDate
+  (period? [this] false)
+  (period [this other] (wrap (Period/between this (unwrap other))))
+  java.lang.String
+  (period? [this] false)
+  (period [this] (wrap (Period/parse this)))
+  java.lang.Object
+  (period? [this] false))

 (defn local-date?
   "Returns true if the given value is a local date."
@@ -175,91 +290,6 @@
   ([prefix offset]
    (wrap
      (ZoneId/ofOffset prefix offset))))
-
-(defn instant
-  "Coerce to instant.
-   Examples:
-
-     => (instant) ; Current instant
-     #<Instant 2015-01-01T12:15:00.123Z>
-     => (instant (clock)) ; Current instant from clock
-     #<Instant 2015-01-01T12:15:00.123Z>
-     => (instant \"2015-01-01T12:15:00.123Z\")
-     #<Instant 2015-01-01T12:15:00.123Z>
-     => (instant :epoch)
-     #<Instant 1970-01-01T00:00:00Z>
-     => (instant (offset-date-time)) ; From date-time containing instant
-     #<Instant 2015-01-01T12:15:00.123Z>"
-  ([]
-   (wrap
-     (Instant/now)))
-  ([x]
-   (wrap
-     (pred-cond-throw x (str "Invalid instant: " x)
-       clock? (Instant/now x)
-       string? (Instant/parse x)
-       keyword? (fields/instants x)
-       :else (Instant/from x)))))
-
-(defn duration
-  "Coerce to duration.
-   Notice that duration is only for exact times, if you are working with dates
-   you most likely want to use a period instead. Can also be used to create a
-   duration from start and end times. See also functions hours, minutes,
-   seconds and nanos, they all return a duration.
-   Examples:
-
-     => (duration \"P2D\") ; 2 days is converted to 48 hours
-     #<Duration PT48H>
-     => (duration \"PT15M\") ; 15 minutes
-     #<Duration PT15M>
-     => (duration \"PT-6H3M\") ; -6 hours and +3 minutes
-     #<Duration PT-5H-57M>
-     => (duration \"-PT6H3M\") ; -6 hours and -3 minutes
-     #<Duration PT-6H-3M>
-     => (duration (instant :epoch) (instant \"2015-01-01T12:15:00.123Z\"))
-     #<Duration PT394476H15M0.123S>
-     => (duration (local-time :midnight) (local-time :noon))
-     #<Duration PT12H>"
-  ([x]
-   (wrap
-     (if (string? x)
-         (Duration/parse x)
-         (Duration/from x))))
-  ([start-inclusive end-exclusive]
-   (wrap
-     (Duration/between start-inclusive end-exclusive))))
-
-(defn period
-  "Coerce to period.
-   Notice that period is only for days and larger time units. If you want to
-   work with time you should use duration instead. Can also be used to create a
-   period from start and end date. See also functions years, months, weeks and
-   days, they all return a period.
-   Examples:
-
-     => (period \"P2Y\")
-     #<Period P2Y>
-     => (period \"P1Y2M3W4D\")
-     #<Period P1Y2M25D>
-     => (period \"P-1Y2M\")
-     #<Period P-1Y2M>
-     => (period \"-P1Y2M\")
-     #<Period P-1Y-2M>
-     => (period :zero)
-     #<Period P0D>
-     => (period (local-date \"2015-01-01\") (local-date \"2017-04-12\"))
-     #<Period P2Y3M11D>"
-  ([x]
-   (wrap
-     (pred-cond-throw x (str "Invalid period: " x)
-       period? x
-       string? (Period/parse x)
-       keyword? (fields/periods x)
-       :else (Period/from x))))
-  ([start-date-inclusive end-date-exclusive]
-   (wrap
-     (Period/between start-date-inclusive end-date-exclusive))))

 (defn local-date
   "Coerce to local date.


Get :added, :retracted for two states

Get :added, :retracted for two states

--- src/clj/libx/rulesclj.clj
+++ src/clj/libx/rulesclj.clj
@@ -29,14 +29,19 @@
 ;
 ;(s/check-asserts true)
 ;(run-tests)
-    (:require [clara.rules :refer [insert insert-all insert! insert-all!
+    (:require [clara.rules :refer [insert!
+                                   insert-all
+                                   insert-all!
                                    insert-unconditional!
                                    insert-all-unconditional!
                                    retract! query fire-rules
                                    mk-session
                                    defrule defquery defsession]]
               [libx.tuplerules :refer [def-tuple-session def-tuple-rule]]
-              [libx.util :refer [map->tuples
+              [libx.util :refer [retract
+                                 insert
+                                 map->tuples
+                                 entities-where
                                     attr-ns]]
               [clara.rules.accumulators :as acc]
               [clara.tools.inspect :as inspect]
@@ -218,26 +223,26 @@
 ;;;;;;;;;;;;;;;

 (def-tuple-rule test-insert-l-retract-l
-  [?f <- [?e :hi]]
+  [?f <- [?e :attr/a]]
   =>
-  (println "Found :hi" ?e)
-  (insert! [?e :my-logical-insert ?f]))
+  (println "Found :attr/a" ?f)
+  (insert! [?e :attr/logical-insert ?f]))

 (def-tuple-rule foooo
-  [[_ :my-logical-insert ?f]]
+  [[_ :attr/logical-insert ?f]]
   =>
   (println "Found " ?f " Retracting its condition for existing")
   (retract! ?f))

 (def-tuple-session the-session 'libx.rulesclj)

-(def tuple-session
+(def state-0
   (-> the-session
     (trace/with-tracing)
     (insert-all (into
-                    [[123 :hi "there"]
-                     [123 :hi "there"]
-                     [123 :oh :hi]]
+                    [[123 :attr/a "state-0"]
+                     [123 :attr/a "state-0"]
+                     [123 :attr/b "state-0"]]
                  (repeatedly 5 #(vector (java.util.UUID/randomUUID) :junk 42))))
     (fire-rules)))

@@ -246,48 +251,59 @@
 ;(inspect/inspect tuple-session)
 ;(inspect/explain-activations tuple-session)

-(def trace (trace/get-trace tuple-session))
-trace
-
-;trace-types
-(into #{} (map :type trace))
-
-(def by-type (select-keys
-               (group-by :type trace)
-               [:add-facts :add-facts-logical :retract-facts :retract-facts-logical]))
-by-type
-
-(def retractions (select-keys by-type [:retract-facts :retract-facts-logical]))
-(def insertions (select-keys by-type [:add-facts :add-facts-logical]))
-retractions
+(def trace-0 (trace/get-trace state-0))
+
+(defn trace-by-type [trace]
+  (select-keys
+    (group-by :type trace)
+    [:add-facts :add-facts-logical :retract-facts :retract-facts-logical]))
+
+(defn retractions [trace-by-type]
+  (select-keys trace-by-type [:retract-facts :retract-facts-logical]))
+
+(defn insertions [trace-by-type]
+  (select-keys trace-by-type [:add-facts :add-facts-logical]))

 (defn list-facts [xs]
   (mapcat :facts (mapcat identity (vals xs))))
-
-(list-facts retractions)
-(list-facts insertions)

 (defn key-by-hashcode [coll]
   "WILL remove duplicates"
   (zipmap (map hash-ordered-coll coll) coll))

-(def hashed-added (key-by-hashcode (list-facts insertions)))
-(def hashed-removed (key-by-hashcode (list-facts retractions)))
-
 (defn select-disjoint [added removed]
-  "Takes m keyed by hashcode"
-  (let [_ (println "Removed" (set (keys removed)))
+  "Takes m keyed by hashcode. Returns same with removals applied to additions"
+  (let [_ (println "Removed" (select-keys removed (set (keys removed))))
         a (set (keys added))
         b (set (keys removed))]
     (select-keys added (remove b a))))

-(def added (into [] (vals (select-disjoint hashed-added hashed-removed))))
-(def removed (into [] (vals hashed-removed)))
-
-added
-removed
-
-
-
-
-(refresh)
+(defn split-ops [trace]
+  "Takes trace returned by Clara's get-trace. Returns m of :adds, :retracts"
+  (let [by-type (trace-by-type trace)
+        hashed-adds (key-by-hashcode (list-facts (insertions by-type)))
+        hashed-retracts (key-by-hashcode (list-facts (retractions by-type)))]
+    {:added (into [] (vals (select-disjoint hashed-adds hashed-retracts)))
+     :retracted (into [] (vals hashed-retracts))}))
+
+(split-ops trace-0)
+
+(entities-where state-0 :attr/a)
+(entities-where state-0 :attr/b)
+
+(def state-1
+  (-> state-0
+    (trace/without-tracing)
+    (trace/with-tracing)
+    (retract [123 :attr/b "state-0"])
+    (insert [123 :attr/b "state-1"])
+    (fire-rules)))
+
+(def trace-1 (trace/get-trace state-1))
+
+(split-ops trace-1)
+
+(entities-where state-1 :attr/a)
+(entities-where state-1 :attr/b)
+
+;(refresh)


Starting to convert to stateful protocol methods in main api

--- src/clj_bots/pin_ctrl.clj
+++ src/clj_bots/pin_ctrl.clj
@@ -24,7 +24,9 @@
 ;; pins, and the current mode settings for those pins.

-(declare board? board-dispatch board-apply)
+(defrecord Board [state-atom impl-board])
+
+(declare board? board-dispatch board-apply chan?)

 ;; We start by creating board objects with the `create-board` function, which returns a board object based
 ;; on the specified `board-type`, which points towards the implementation key for the device being used (e.g.
@@ -37,7 +39,7 @@
   ([type]
    (create-board type {}))
   ([type config]
-   (impl/instantiate type config)))
+   (Board. (atom {}) (impl/instantiate type config))))

 ;; What follows then are a suite of simple tools for dealing with the boards.

@@ -161,47 +163,56 @@
 ;; The usage pattern involves first setting the edge detection mode of the pin, then tapping into a central
 ;; channel and using that tap to convey messages of state changes throughout the app.

+
+(defn set-edge-chan!
+  "Set the edge channel for the specified pin. If there is an existing channel for the pin, it will be
+  closed."
+  ([board pin-n ch]
+   (sw/set-edge-chan! board pin-n ch))
+  ([pin ch]
+   (board-apply sw/set-edge-chan! pin ch)))
+
+(defn get-edge-chan
+  "Get the current edge channel for the specified pin."
+  ([board pin-n]
+   (sw/get-edge-chan board pin-n))
+  ([pin]
+   (board-apply sw/get-edge-chan pin)))
+
 (defmulti set-edge!
   "Set the edge direction of a pin. Accepts `:falling`, `:rising`, `:both` and `:none` edges.
-  Args should either be `[pin edge & [buffer]]` or `[board pin-n edge & [buffer]]`, where buffer is the size of
-  the channel which will be tapped in the tapping functions (defaults to 1)."
+  Args should either be `[pin edge & [ch-or-buffer]]` or `[board pin-n edge & [ch-or-buffer]]`.
+  Edge events will be placed on the specified channel or one that is created with the given buffer.
+  If ch-or-buffer is not specified, an unbeffered chan is returned.
+  The channel can be changed with `set-edge-chan!` and retrieved with `get-edge-chan`."
   board-dispatch)

 (defmethod set-edge! true
-  [board pin-n edge & [buffer]]
-  (p/set-edge! board pin-n edge (or buffer 1)))
+  [board pin-n edge & [ch-or-buffer]]
+  (let [current-ch (get-edge-chan board pin-n)
+        ch (cond
+             (chan? ch-or-buffer) ch
+             ch-or-buffer         (chan ch-or-buffer)
+             current-ch           current-ch
+             :else                (chan))]
+    (sw/set-edge-chan! board pin-n ch)
+    (pcp/set-edge! board pin-n edge ch)))

 (defmethod set-edge! false
-  [pin edge & [buffer]]
-  (board-apply p/set-edge! pin edge (or buffer 1)))
-
-(defmulti create-edge-tap!
-  "Create an edge tap for the given edge channel"
-  board-dispatch)
-
-(defmethod create-edge-tap! true
-  [board pin-n & [buffer]]
-  (async/tap (p/get-edge-mult board pin-n) (chan (or buffer 1))))
-
-(defmethod create-edge-tap! false
-  [pin [buffer]]
-  (board-apply create-edge-tap! pin buffer))
-
-(defn remove-edge-tap!
-  "Untap edge channel tap"
-  ([board pin-n tap-chan]
-   (async/untap (p/get-edge-mult board pin-n) tap-chan))
-  ([pin tap-chan]
-   (board-apply remove-edge-tap! pin tap-chan)))
+  [pin edge & [ch-or-buffer]]
+  (board-apply set-edge! pin edge ch-or-buffer))

 ;; ### Some helper functions for navigating through boards and pins.

 ;; Nothing to see here...

+;(defn- board?
+  ;[obj]
+  ;(satisfies? p/PBoard obj))
 (defn- board?
   [obj]
-  (satisfies? p/PBoard obj))
+  (= (type obj) Board))

 (defn- board-dispatch
   [x & args] (board? x))
@@ -210,4 +221,8 @@
   [f pin & args]
   (apply f (:board pin) (:pin-n pin) args))

-
+(defn- chan?
+  [c]
+  (and (satisfies? clojure.core.async.impl.protocols/ReadPort c)
+       (satisfies? clojure.core.async.impl.protocols/WritePort c)))
+


use 'value' instead of 'balance'

use 'value' instead of 'balance'

--- src/clj_money/reports.clj
+++ src/clj_money/reports.clj
@@ -18,18 +18,18 @@
 (defn- set-balance-delta
   [storage-spec account start end]
   (let [children (set-balance-deltas storage-spec start end (:children account))
-        new-children-balance (reduce #(+ %1
-                                         (:balance %2)
-                                         (:children-balance %2))
+        new-children-value (reduce #(+ %1
+                                         (:value %2)
+                                         (:children-value %2))
                                      0
                                      children)
-        new-balance (transactions/balance-delta storage-spec
-                                                (:id account)
-                                                start
-                                                end)]
+        new-value (transactions/balance-delta storage-spec
+                                              (:id account)
+                                              start
+                                              end)]
     (assoc account :children children
-                   :children-balance new-children-balance
-                   :balance new-balance)))
+                   :children-value new-children-value
+                   :value new-value)))

 ; TODO consider removing this function
 (defn- set-balance-deltas
@@ -40,8 +40,8 @@
   [account-group calc-fn]
   (let [updated (update-in account-group [:accounts] calc-fn)]
     (assoc updated :value (reduce #(+ %1
-                                      (:balance %2)
-                                      (:children-balance %2))
+                                      (:value %2)
+                                      (:children-value %2))
                                   (bigdec 0)
                                   (:accounts updated)))))

@@ -74,14 +74,14 @@
   [storage-spec entity account as-of]
   (let [children (set-balances storage-spec entity as-of (:children account))
         new-children-balance (reduce #(+ %1
-                                         (:balance %2)
-                                         (:children-balance %2))
+                                         (:value %2)
+                                         (:children-value %2))
                                      0
                                      children)
         new-balance (account-value-as-of storage-spec entity account as-of)]
     (assoc account :children children
-                   :children-balance new-children-balance
-                   :balance new-balance)))
+                   :children-value new-children-balance
+                   :value new-balance)))

 ; TODO consider removing this function
 (defn- set-balances
@@ -98,7 +98,7 @@
 (defn- transform-account
   [account depth]
   (concat [{:caption (:name account)
-            :value (+ (:balance account) (:children-balance account))
+            :value (+ (:value account) (:children-value account))
             :style :data
             :depth depth}]
           (mapcat #(transform-account % (+ 1 depth))
@@ -166,8 +166,8 @@
                (-> entry
                    (update-in [:accounts] #(concat %
                                                    [{:name caption
-                                                     :balance value
-                                                     :children-balance 0}]))
+                                                     :value value
+                                                     :children-value 0}]))
                    (update-in [:value] #(+ % value))))))

 (def ^:private pseudo-accounts


* src/cljs/cljs/reader.cljs: seems to work

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -71,7 +71,7 @@
   (throw (apply str msg)))

 (defn macro-terminating? [ch]
-  (and (not= ch "#") (not= ch \') (contains? macros ch)))
+  (and (not= ch "#") (not= ch \') (not= ch ":") (contains? macros ch)))

 (defn read-token
   [rdr initch]


Added comment handling to reader

Added comment handling to reader

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -62,6 +62,14 @@

 (declare read)

+(defn- skip-line
+  "Advances the reader to the end of a line. Returns the reader"
+  [reader]
+  (let [ch (read-char reader)]
+    (if (or (= ch \n) (= ch r) (nil? ch))
+      reader
+      (recur reader))))
+
 (defn read-number
   [reader])

@@ -84,7 +92,7 @@
   (if (not (nil? (peek reader)))
     (cond
      (whitespace? reader) (do (read-char reader) (recur reader))
-     (comment? reader) nil ;; TODO: burn through until end of comment
+     (comment? reader) (recur (skip-line reader))
      (number-literal? reader) (read-number reader)
      (string-literal? reader) (read-string reader)
      (vector-literal? reader) (read-vector reader)


fix day filter selector

fix day filter selector

--- src/cljs/tictag/subs.cljs
+++ src/cljs/tictag/subs.cljs
@@ -411,7 +411,7 @@
 (reg-sub
  :pie-filters/days
  (fn [db _]
-   (let [active-days (get-in db [:pie/filters :days])]
+   (let [active-days (get-in db [:pie/filters :days] (set days))]
      (map
       (fn [day]
         {:selected? (get active-days day)
@@ -428,12 +428,14 @@
  :pie-filters/all-days?
  (fn [_ _] (subscribe [:pie-filters/day-set]))
  (fn [days]
-   (= days (clojure.set/union weekdays weekends))))
+   (or (nil? days)
+       (= days (clojure.set/union weekdays weekends)))))

 (reg-sub
  :pie-filters/no-days?
  (fn [_ _] (subscribe [:pie-filters/day-set]))
- (fn [days] (empty? days)))
+ (fn [days] (and (empty? days)
+                 (not (nil? days)))))

 (reg-sub
  :pie-filters/weekdays-only?


Removing TODO

Removing TODO

--- src/cmr/acl/acl_cache.clj
+++ src/cmr/acl/acl_cache.clj
@@ -50,11 +50,6 @@
       acls
       (errors/internal-error! "ACLS were not in cache."))))

-;; TODO we need a way to manually trigger this from integration tests.
-;; Add an endpoint to search and indexer for refreshing the acl cache.
-;; We could make it part of the refresh call that the cache is cleared and then allow a search hitting
-;; a null cache to trigger it being refreshed.
-
 (defjob RefreshAclCacheJob
   [ctx system]
   (refresh-acl-cache {:system system}))


Finish to adapt to new leiningen-core keys

--- ccw.leiningen/src/clj/ccw/leiningen/nature.clj
+++ ccw.leiningen/src/clj/ccw/leiningen/nature.clj
@@ -120,9 +120,9 @@
 (defn lein-raw-source-folders [lein-proj]
   (concat (:source-paths lein-proj)))

-(defn lein-raw-resource-folders [lein-proj]
+(defn lein-raw-optional-source-folders [lein-proj]
   (concat (:test-paths lein-proj)
-          (:resources-paths lein-proj)))
+          (:resource-paths lein-proj)))

 (defn lein-raw-compile-folder [lein-proj] (:compile-path lein-proj))

@@ -132,8 +132,8 @@
 (defn lein-source-folders [lein-proj]
   (map path-to-folder (lein-raw-source-folders lein-proj)))

-(defn lein-resource-folders [lein-proj]
-  (map path-to-folder (lein-raw-resource-folders lein-proj)))
+(defn lein-optional-source-folders [lein-proj]
+  (map path-to-folder (lein-raw-optional-source-folders lein-proj)))

 (defn lein-compile-folder [lein-proj]
   (-> lein-proj lein-raw-compile-folder path-to-folder))
@@ -164,19 +164,20 @@
         optional-entry-start-version (b/version :major 0 :minor 8 :micro 0 :qualifier "201204121312")
         ccw-version (or (ccw-bundle-version) (b/version :major 9999 :minor 9999 :micro 9999))
         optional-entries? (b/> ccw-version optional-entry-start-version)
-
+
         _ (println "will handle optional entries: " optional-entries?)
+        _ (println "resource-folders:" (lein-optional-source-folders lein-proj))
         ; TODO remove the folder check, and add the optional extra attribute
         resource-entries (if optional-entries?
                            (->> lein-proj
-                             lein-resource-folders
+                             lein-optional-source-folders
                              (map #(u/source-entry {:path %,
                                                     :extra-attributes {u/optional "true"}})))
                            (->> lein-proj
-                             lein-resource-folders
+                             lein-optional-source-folders
                              (filter #(.exists %))
                              (map #(u/source-entry {:path %}))))
-
+        _ (println "resource entries:" resource-entries)
         compile-entry    (u/library-entry {:path (lein-compile-folder lein-proj)
                                            :extra-attributes {u/optional "true"}})


dangerouslySetInnerHTML must have non-nil __html

--- frontend/src/faceboard/helpers/utils.cljs
+++ frontend/src/faceboard/helpers/utils.cljs
@@ -11,7 +11,9 @@
     (js->clj obj :keywordize-keys true)))

 (defn non-sanitized-div [content]
-  (dom/div {:dangerouslySetInnerHTML #js {:__html content}}))
+  (if content
+    (dom/div {:dangerouslySetInnerHTML #js {:__html content}})
+    (dom/div)))                                             ; note: nil content would cause firing React's assertion

 (defn find-first [f coll]
   (first (filter f coll)))


CMR-4405: Fixed test.

CMR-4405: Fixed test.

--- metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
+++ metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
@@ -428,18 +428,21 @@

 (defn- delete-associations
   "Delete the associations associated with the given collection revision and association type,
-  no variable association deletion event is generated."
+  no association deletion event is generated."
   [context assoc-type coll-concept-id coll-revision-id]
-  (doseq [va (search/find-concepts context {:concept-type assoc-type
-                                            :associated-concept-id coll-concept-id
-                                            :associated-revision-id coll-revision-id
-                                            :exclude-metadata true
-                                            :latest true})]
-    (save-concept-revision context {:concept-type assoc-type
-                                    :concept-id (:concept-id va)
-                                    :deleted true
-                                    :user-id "cmr"
-                                    :skip-publication true})))
+  (let [search-params (cutil/remove-nil-keys
+                       {:concept-type assoc-type
+                        :associated-concept-id coll-concept-id
+                        :associated-revision-id coll-revision-id
+                        :exclude-metadata true
+                        :latest true})
+        associations (search/find-concepts context search-params)]
+    (doseq [association associations]
+      (save-concept-revision context {:concept-type assoc-type
+                                      :concept-id (:concept-id association)
+                                      :deleted true
+                                      :user-id "cmr"
+                                      :skip-publication true}))))

 (defn- delete-associated-variable-associations
   "Delete the variable associations associated with the given collection revision,


alpha of port to neo4j bolt

alpha of port to neo4j bolt

--- src/grape/core.clj
+++ src/grape/core.clj
@@ -8,9 +8,6 @@
    [grape.tx-cypher :refer :all]
    [grape.util :refer :all]
    [grape.analysis :refer :all]
-   [clojurewerkz.neocons.rest.cypher :as cy]
-   [clojurewerkz.neocons.rest :as nr]
-   [clojurewerkz.neocons.rest.transaction :as nt]
    [grape.tx-cypher :refer :all]
    [environ.core :refer [env]]
    [taoensso.timbre :as timbre
@@ -20,7 +17,9 @@
    [taoensso.timbre.profiling :as profiling
     :refer (pspy pspy* profile defnp p p*)]
    [dorothy.core :as dorothy]
-   [gorilla-graph.core :as gorillagraph]))
+   [neo4j-clj.core :as db]
+   [gorilla-graph.core :as gorillagraph])
+   (:import (java.net URI)))

 (use 'clojure.walk)

@@ -68,7 +67,10 @@
   (swap! queries-atom (fn [c] (assoc c n s))))

 (def conn (try
-           (nr/connect dburi dbusr dbpw)
+         (-> (db/connect (URI. "bolt://localhost:7687")
+                       "neo4j"
+                       "grape")
+             db/get-session)
             (catch Exception e (println (str "Caught exception: " (.toString e))))
             (finally "UNSUCCESSFUL")))

@@ -76,15 +78,8 @@

 (defn dbquery [q]
   (debug println "DBQuery: " q)
-  (let [res (try (cy/query conn q)
-                 (catch Exception e (println (str "Caught exception: " (.toString e))))
-                 (finally "UNSUCCESSFUL"))]
-    (debug println "************* done \n")
-    res))
-
-(defn dbtquery [q]
-  (debug println "DBQuery: " q)
-  (let [res (try (cy/tquery conn q)
+  (let [qf (db/create-query q)
+        res (try (qf conn)
                  (catch Exception e (println (str "Caught exception: " (.toString e))))
                  (finally "UNSUCCESSFUL"))]
     (debug println "************* done \n")
@@ -138,46 +133,6 @@
      :arrows {:to {:enabled true}}}))

-(defn pattern->view
-  "translate a graph pattern to dot."
-  [p c d]
-  (let [m    (second p)
-        els  (:els m)
-        nodes (map (partial node->view c d) (filter-elem 'node els))
-        edges (map (partial edge->view c d) (filter-elem 'edge els))]
-    {:nodes (vec nodes)
-     :edges (vec edges)}))
-
-
-(defn rule->view [rid]
-  "translate a rule to view"
-  (let [n (name rid)
-        rule ((rules) rid)
-        r (:read rule)
-        d (:delete rule)
-        c (:create rule)
-        p (:params rule)]
-    (if (empty? rule)
-      {:nodes [:id 0 :shape "text" :label "** NO SUCH RULE **"]}
-      {:nodes (vec (concat [{:id 0
-                             :label (str "RULE: " n (if (empty? p) "" (str p)))
-                             :shape "text"
-                             :font {:size 20 :bold true}}]
-                           (-> (pattern->view r false d) :nodes)
-                           (-> (pattern->view c true []) :nodes)))
-       :edges (vec (concat
-                    (-> (pattern->view r false d) :edges)
-                    (-> (pattern->view c true []) :edges)))}
-      )))
-
-(defn show-view [v]
-  (gorillagraph/view v {:height "200px"}) )
-
-
-
-
-
-

 ; ---------------------------------------------------
 ; DSL
@@ -263,14 +218,21 @@
           ei (map f ec)]
       (reduce (partial str-sep " AND ") (concat ni ei)))))

+(defn readnodeRet->cypher [n]
+  (let [id (-> n second :id)]
+    (str id "{.*, "
+         "id:ID(" id "), "
+         "labels:labels(" id ")} ")))
+
+
 (defn search [g n pars]
   (let [r ((rules) n)
         nodesToRead (filter-elem 'node (-> r :read second :els))
         nodesToReadStr (apply str (interpose " WITH * " (map readnode->cypher nodesToRead)))
-        nodesToReturnStr (apply str (interpose "," (map #(-> % second :id) nodesToRead)))
+        nodesToReturnStr (apply str (interpose "," (map readnodeRet->cypher nodesToRead)))
         edgesToRead (filter-elem 'edge (-> r :read second :els))
         edgesToReadStr (apply str (interpose " WITH * " (map readedge->cypher edgesToRead)))
-        edgesToReturnStr (apply str (interpose "," (map #(-> % second :id) edgesToRead)))
+        edgesToReturnStr (apply str (interpose "," (map readnodeRet->cypher edgesToRead)))
         qstr (str "MATCH (_g:`__Graph` {uid:\"" g "\"}) "
                   nodesToReadStr
                   " WITH * " edgesToReadStr
@@ -285,53 +247,60 @@
                   " RETURN _g "
                   (if (not (empty? nodesToReturnStr)) (str "," nodesToReturnStr))
                   (if (not (empty? edgesToReturnStr)) (str "," edgesToReturnStr)))]
-   (->> (dbtquery qstr)
-        (map (fn [row] (map (fn [col]
-                              (assoc (select-keys (second col) [:data :metadata])
-                                     :handle (first col)))
-                            row))))))
-
-
+   (dbquery qstr)))
+
+
+(defn getHandle [e]  (-> e first name))
+
+(defn getId [e]  (-> e second :id))

 (defn nodeRem->cypher [n]
-  (let [id   (-> n (:metadata) (:id))
-        handle (-> n (:handle))]
+  (let [id   (getId n)
+        handle (getHandle n)]
     (str  " MATCH(" handle ") WHERE ID( " handle ")=" id)))

 (defn derive [g n pars redex]
   (let [r ((rules) n)
-        nodesToRematch (filter (fn [x] (some #(= "__Node" %) (-> x :metadata :labels))) redex)
+        nodesToRematch (filter (fn [x] (some #(= "__Node" %) (-> x second :labels))) redex)
         nodesToRematchStr (apply str (map nodeRem->cypher nodesToRematch))
-        edgesToRematch (filter (fn [x] (some #(= "__Edge" %) (-> x :metadata :labels))) redex)
+        edgesToRematch (filter (fn [x] (some #(= "__Edge" %) (-> x second :labels))) redex)
         edgesToRematchStr (apply str (map nodeRem->cypher edgesToRematch))
-        itemsDeleteStr (apply str (interpose " WITH * " (map delitem->cypher (:delete r))))
+        itemsDeleteStr (if (empty? (:delete r))
+                         " "
+                         (str " WITH * "(apply str (interpose " WITH * " (map delitem->cypher (:delete r))))))
         nodesToRead (filter-elem 'node (-> r :read second :els))
-        nodesToReadStr2 (apply str (interpose " WITH * " (map readnode->cypher2 nodesToRead)))
+        nodesToReadStr2 (if (empty? nodesToRead)
+                          ""
+                          (str " WITH * "(apply str (interpose " WITH * " (map readnode->cypher2 nodesToRead)))))
         nodesToCreate (filter-elem 'node (-> r :create second :els))
-        nodesToCreateStr (apply str (interpose " WITH * " (map createnode->cypher nodesToCreate)))
+        nodesToCreateStr (if (empty? nodesToCreate)
+                           ""
+                           (str " WITH * " (apply str (interpose " WITH * " (map createnode->cypher nodesToCreate)))))
         edgesToCreate (filter-elem 'edge (-> r :create second :els))
-        edgesToCreateStr (apply str (interpose " WITH * " (map createedge->cypher edgesToCreate)))
+        edgesToCreateStr (if (empty? edgesToCreate)
+                           ""
+                           (str " WITH * "(apply str (interpose " WITH * " (map createedge->cypher edgesToCreate)))))
         qstr (str "MATCH (_g:`__Graph` {uid:\"" g "\"}) "
                   nodesToRematchStr
                   " WITH * " edgesToRematchStr
                   " CREATE (_gn:`__Graph`{uid: apoc.create.uuid()})-[:prov{rule:\"" n "\"}]->(_g) "
                   nodesToCreateStr
-                  " WITH * "
                   nodesToReadStr2
-                  " WITH * "
                   edgesToCreateStr
-                  " WITH * "
                   itemsDeleteStr
                   " RETURN _gn")]
     (let [g (->
              (dbquery qstr)
-             first second first first :data :uid)]
+             first
+             :_gn :uid
+             list)]
       (when (not (empty? g)) (set-graph! g))
       g)))

-(defn exec [g n par]
-  (let [redexes (search g n par)]
+(defn exec [gs n par]
+  (let [g (first gs)
+        redexes (search g n par)]
     (if (empty? redexes)
       nil
       (derive g n par (first redexes)))))
@@ -365,7 +334,7 @@
                     "")
                   " RETURN _g," nodesToReturnStr ","
                   edgesToReturnStr1 "," edgesToReturnStr2 "," edgesToReturnStr3)]
-    (->> (dbtquery qstr)
+    (->> (dbquery qstr)
         (map (fn [row] (map (fn [col]
                            (assoc (select-keys (second col) [:data :metadata])
                                   :handle (first col)))
@@ -403,7 +372,7 @@
   "DSL form to create a new graph"
   (let [g (->
          (dbquery (str "create (g:`__Graph` {uid: apoc.create.uuid()}) return g"))
-         first second first first :data :uid)]
+         first :g :uid list)]
     (set-graph! g)
     g))

@@ -585,7 +554,7 @@
   "return the occurance of kind nodes for graph g"
   (let [qstr (str "match(g:`__Graph` {uid:'" g "'}) -[:" kind "]->(n:`__Node`) RETURN n  ")]
     (->>
-     (dbtquery qstr)
+     (dbquery qstr)
      (map #(-> % (get-in ["n"]) (select-keys [:metadata :data]))))))

 (defn occdelnodes [g]
@@ -600,7 +569,7 @@
 (defn occedges [g kind]
   "return the occurance of kind nodes for graph g"
   (->>
-   (dbtquery (str "match(g:`__Graph` {uid:'" g "'}) -[:" kind "]->(e:`__Edge`)
+   (dbquery (str "match(g:`__Graph` {uid:'" g "'}) -[:" kind "]->(e:`__Edge`)
                       WITH * match (e)-[:src]->(s)
                       WITH * match (e)-[:tar]->(t)
                       RETURN e,s,t  "))
@@ -622,7 +591,7 @@
 (defn occgraphs [g]
   "search for g and its provenance"
   (let [res (->
-             (dbtquery  (str "match(g:`__Graph` {uid:'" g "'}) "
+             (dbquery  (str "match(g:`__Graph` {uid:'" g "'}) "
                              " OPTIONAL MATCH(g)-[e:prov]->(p) return g,e,p"))
              first)]
     {:g (get-in res ["g" :data :uid])
@@ -714,7 +683,7 @@

 (defn viewproc [g]
   "view the graph process"
-  (let [p (dbtquery (str "match (g1:`__Graph`)-[:prov*0..]-(:`__Graph`{uid:\"" g "\"}) OPTIONAL match (g2)-[e:prov]->(g1:`__Graph`) return g1,e,g2"))
+  (let [p (dbquery (str "match (g1:`__Graph`)-[:prov*0..]-(:`__Graph`{uid:\"" g "\"}) OPTIONAL match (g2)-[e:prov]->(g1:`__Graph`) return g1,e,g2"))
         nodes (map step->dot p)
         nodeStr (apply str (interpose " \n " nodes))
         edges (map prov->dot p)
@@ -893,4 +862,26 @@
                    (map cross_empty* safeGs)))))
         (commit (first solutions) "solution")))))

-)+)
+
+
+(rule 'hello
+      :create (pattern
+               (node :label "Hello")))
+
+(rule 'world
+      :read 	(pattern
+              (node 'h :label "Hello"))
+      :create	(pattern
+               (node 'w :label "World")
+               (edge :src 'h :tar 'w :label "to")))
+
+(rule 'vine
+      :read 	(pattern
+              (node 'h :label "Hello")
+              (node 'w :label "World")
+              (edge 'e :src 'h :tar 'w :label "to"))
+      :delete ['w 'e]
+      :create	(pattern
+               (node 'g :label "Grape")
+               (edge :src 'h :tar 'g :label "to")))


Fix bugs and update other constraints

Fix bugs and update other constraints

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -464,7 +464,7 @@

 (deftype Contains [iterator vars scratch-key]
   Object
-  (reset [this solver]
+  (reset [this solver constraint]
          (.reset iterator))
   (propagate [this solver constraint]
              (let [los (.-los solver)
@@ -490,7 +490,7 @@
                          (.set-lo solver var (aget new-los i))
                          (if (identical? (aget new-los i) (aget his var))
                            (recur (+ i 1))
-                           (.set-watch solver constraint var true)))))))))
+                           (.set-watch solver var constraint true)))))))))
   (split-left [this solver constraint]
               ;; fix the value of the first non-fixed var
              (let [los (.-los solver)
@@ -503,7 +503,7 @@
                        (do
                          (.set-hi solver var (aget los var))
                          (when (< (+ i 1) (alength vars))
-                           (.set-watch solver constraint (aget vars (+ i 1)) true))
+                           (.set-watch solver (aget vars (+ i 1)) constraint true))
                          true)))
                    false))))
   (split-right [this solver constraint]
@@ -539,53 +539,64 @@
   (let [key-len (.-key-len (.-tree iterator))]
     (Contains. iterator vars (make-array key-len))))

-;; TODO for these constraints would be useful to be able to disable the constraints once they run succesfully
-
-(deftype Constant [c]
+(deftype Constant [c var]
   Object
-  (reset [this])
-  (split-left [this los his])
-  (split-right [this los his])
-  (propagate [this los his]
-             (aset los 0 c)
-             (aset his 0 c)))
-
-(defn constant [c]
-  (Constant. c))
-
-(deftype Equal []
+  (reset [this solver constraint])
+  (split-left [this solver constraint]
+              false)
+  (split-right [this solver constraint])
+  (propagate [this solver constraint]
+             (.set-eq solver var c)))
+
+(defn constant [c var]
+  (Constant. c var))
+
+(deftype Equal [vars]
   Object
-  (reset [this])
-  (split-left [this los his])
-  (split-right [this los his])
-  (propagate [this los his]
-             (loop [i 0]
-               (when (< i (alength los))
-                 (if (identical? (aget los i) (aget his i))
-                   (dotimes [j (alength los)]
-                     (aset los j (aget los i))
-                     (aset his j (aget his i)))
-                   (recur (+ i 1)))))))
-
-(defn equal []
-  (Equal.))
-
-(deftype Function [f]
+  (reset [this solver constraint]
+         (dotimes [i (alength vars)]
+           (.set-watch solver (aget vars i) constraint true)))
+  (split-left [this solver constraint]
+              false)
+  (split-right [this solver constraint])
+  (propagate [this solver constraint]
+             (let [los (.-los solver)
+                   his (.-his solver)]
+               (loop [i 0]
+                 (when (< i (alength vars))
+                   (let [var (aget vars i)]
+                     (if (identical? (aget los var) (aget his var))
+                       (do
+                         (dotimes [j (alength vars)]
+                           (.set-eq solver (aget vars j) (aget los var)))
+                         (aset (.-constraint->dirty? solver) constraint false))
+                       (recur (+ i 1)))))))))
+
+(defn equal [vars]
+  (Equal. vars))
+
+(deftype Function [f var vars scratch]
   Object
-  (reset [this])
-  (split-left [this los his])
-  (split-right [this los his])
-  (propagate [this los his]
-             (loop [i 0]
-               (if (< i (- (alength los) 1))
-                 (when (identical? (aget los i) (aget his i))
-                   (recur (+ i 1)))
-                 (let [val (.apply f nil los)]
-                   (aset los (- (alength los) 1) val)
-                   (aset his (- (alength his) 1) val))))))
-
-(defn function [f]
-  (Function. f))
+  (reset [this solver constraint]
+         (dotimes [i (alength vars)]
+           (.set-watch solver (aget vars i) constraint true)))
+  (split-left [this solver constraint]
+              false)
+  (split-right [this solver constraint])
+  (propagate [this solver constraint]
+             (let [los (.-los solver)
+                   his (.-his solver)]
+               (loop [i 0]
+                 (if (< i (alength vars))
+                   (let [var (aget vars i)]
+                     (when (identical? (aget los var) (aget his var))
+                       (aset scratch i (aget los var))
+                       (recur (+ i 1))))
+                   (let [val (.apply f nil scratch)]
+                     (.set-eq solver var val)))))))
+
+(defn function [f var vars]
+  (Function. f var vars (make-array (alength vars))))

 ;; SOLVER

@@ -611,7 +622,7 @@
          (aclear pushed-constraint->dirty?)
          (aclear pushed-splitters)
          (dotimes [constraint (alength constraints)]
-           (.reset (aget constraints constraint) constraint)))
+           (.reset (aget constraints constraint) this constraint)))
   (set-lo [this var new-lo]
           (when-not (identical? (aget los var) new-lo)
             (if (val-lt (aget his var) new-lo)
@@ -630,13 +641,13 @@
           (let [old-lo (aget los var)
                 old-hi (aget his var)]
             (when-not (and (identical? old-lo new-val) (identical? old-hi new-val))
-              (if (or (val-lt new-val old-hi) (val-lt old-hi new-val))
+              (if (or (val-lt new-val old-lo) (val-lt old-hi new-val))
                 (set! failed? true)
                 (do
                   (aset los var new-val))
                   (aset his var new-val)
                   (.set-dirty this var)))))
-  (set-watch [this constraint var value]
+  (set-watch [this var constraint value]
              (aset var->constraint->watching? (+ (* (alength constraints) var) constraint) value))
   (set-dirty [this var]
              (let [start (* (alength constraints) var)]
@@ -1095,9 +1106,10 @@
       _ (.assoc! tree2 #js ["b" "d"] 0)
       s (solver 3
                 #js [(contains (iterator tree1) #js [0 2])
-                     (contains (iterator tree2)) #js [1 2]])
+                     (contains (iterator tree2) #js [1 2])])
       ]
-  [(.next s) (.next s) (.next s) (.next s) (.next s)]
+    (.reset s)
+  (take 100 (take-while identity (repeatedly #(.next s))))
   )

   (let [tree1 (tree 10)
@@ -1111,14 +1123,12 @@
       _ (.assoc! tree2 #js ["d" "c"] 0)
       _ (.assoc! tree2 #js ["b" "d"] 0)
       s (solver 4
-                #js [(contains (iterator tree1))
-                     (contains (iterator tree2))
-                     (function identity)]
-                #js [#js [0 1]
-                     #js [2 3]
-                     #js [1 3]])
+                #js [(contains (iterator tree1) #js [0 1])
+                     (contains (iterator tree2) #js [2 3])
+                     (function identity 1 #js [3])])
       ]
-  [(.next s) (.next s) (.next s) (.next s) (.next s)]
+    (.reset s)
+  (take 100 (take-while identity (repeatedly #(.next s))))
   )

   (let [tree1 (tree 10)
@@ -1132,14 +1142,12 @@
       _ (.assoc! tree2 #js ["d" "c"] 0)
       _ (.assoc! tree2 #js ["b" "d"] 0)
       s (solver 4
-                #js [(contains (iterator tree1))
-                     (contains (iterator tree2))
-                     (equal)]
-                #js [#js [0 1]
-                     #js [2 3]
-                     #js [1 3]])
+                #js [(contains (iterator tree1) #js [0 1])
+                     (contains (iterator tree2) #js [2 3])
+                     (equal #js [1 3])])
       ]
-  [(.next s) (.next s) (.next s) (.next s) (.next s)]
+    (.reset s)
+  (take 100 (take-while identity (repeatedly #(.next s))))
   )

  )


Make sure musiknoten and tactile books are listed under Braille

--- src/catalog/latex.clj
+++ src/catalog/latex.clj
@@ -46,10 +46,13 @@
                    :jugendbücher "Jugendbücher"
                    :kinder-und-jugendsachbücher "Kinder- und Jugendsachbücher"
                    :kinderbücher-ab-10 "Kinderbücher (ab 10)"
-                   :kinderbücher-ab-6 "Kinderbücher (ab 6)"})
+                   :kinderbücher-ab-6 "Kinderbücher (ab 6)"
+                   :musiknoten "Braille-Musiknoten"
+                   :taktilesbuch "Taktile Bücher"})

 (def formats [:hörbuch :braille :grossdruck :e-book :hörfilm :ludo])
 (def genres [:belletristik :sachbücher :kinder-und-jugendbücher])
+(def braille-genres (conj genres :musiknoten :taktilesbuch))
 (def subgenres [:action-und-thriller :beziehungsromane :fantasy-science-fiction
                 :gesellschaftsromane :historische-romane :hörspiele :krimis
                 :lebensgeschichten-und-schicksale :literarische-gattungen
@@ -228,7 +231,8 @@
        :else (catalog-entries items)))))

 (defn genre-entries [fmt items]
-  (string/join (for [genre genres] (genre-entry fmt genre items))))
+  (let [genres (if (= fmt :braille) braille-genres genres)]
+    (string/join (for [genre genres] (genre-entry fmt genre items)))))

 (defn format-entry [fmt items]
   (when-let [items (fmt items)]


Deal with tactile books that are only for sale

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -352,6 +352,11 @@
               ;; signature starts with "TB"
               (and (= fmt :ludo) library-signature
                    (re-find #"^TB " library-signature)) :taktilesbuch
+              ;; tactile books that are only for sale do not have a
+              ;; signature that starts with "TB". However if they are
+              ;; print-and-braille? we also treat them as tactile
+              ;; books
+              (and (= fmt :ludo) print-and-braille?) :taktilesbuch
               :else fmt)
         item (-> {}
                  (assoc-some


Order and group the catalog items

Order and group the catalog items

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -95,6 +95,19 @@
        :format (format-raw-to-format format-raw))
       (dissoc :genre-raw :format-raw)))

+(defn order-and-group [items]
+  (->>
+   items
+   (sort-by (juxt :creator :title))
+   (reduce
+    (fn [m {:keys [format genre sub-genre] :as item}]
+      (let [update-keys
+            (cond
+              (= format :hörbuch) [format genre sub-genre]
+              (#{:hörfilm :ludo} format) [format]
+              (= genre :kinder-und-jugendbücher) [format genre sub-genre]
+              :else [format genre])]
+        (update-in m update-keys (fnil conj []) item))) {})))

 (defn read-file
   "Read an export file from VUBIS and return a map with all the data"


Add doc strings for clojure-json aliases

--- src/cheshire/core.clj
+++ src/cheshire/core.clj
@@ -267,10 +267,10 @@
                     key-fn array-coerce-fn))))

 ;; aliases for clojure-json users
-(def encode generate-string)
-(def encode-stream generate-stream)
-(def encode-smile generate-smile)
-(def decode parse-string)
-(def decode-strict parse-string-strict)
-(def decode-stream parse-stream)
-(def decode-smile parse-smile)
+(def encode "Alias to generate-string for clojure-json users" generate-string)
+(def encode-stream "Alias to generate-stream for clojure-json users" generate-stream)
+(def encode-smile "Alias to generate-smile for clojure-json users" generate-smile)
+(def decode "Alias to parse-string for clojure-json users" parse-string)
+(def decode-strict "Alias to parse-string-strict for clojure-json users" parse-string-strict)
+(def decode-stream "Alias to parse-stream for clojure-json users" parse-stream)
+(def decode-smile "Alias to parse-smile for clojure-json users" parse-smile)


Add isolate of clj-stacktrace

Add isolate of clj-stacktrace

--- resources/spec.clj
+++ resources/spec.clj
@@ -67,6 +67,8 @@
                       ;; The http-kit AsyncChannel is not isolated because of pubsure-reader app.
                       ;; Keep this in mind when seeking leaks. :)
                       ;;"org\\.httpkit\\.(?!server\\.AsyncChannel).*"
+                      ;; lighttable-nrepl deps
+                      "clj_stacktrace.*"
                       ]}
  :repl {:port 13337}
  :fs {:deployments "deployments"}


Bugfix negamax (wip)

Bugfix negamax (wip)

--- src/connect5_ai/core.clj
+++ src/connect5_ai/core.clj
@@ -29,8 +29,8 @@
       (reduce
         (fn [col [col-idx charac]]
           (case charac
-            1 (assoc col true (cons [line-idx col-idx] (true col)))
-            2 (assoc col false (cons [line-idx col-idx] (false col)))
+            1 (assoc col true (cons [line-idx col-idx] (col true)))
+            2 (assoc col false (cons [line-idx col-idx] (col false)))
             col))
         ret-map
         (map-indexed vector (first charmat)))
@@ -66,12 +66,12 @@
 (defn is-terminal-state
   ""
   [state]
-  )
+  false)

 (defn get-value-for-state
   ""
   [state]
-  )
+  (rand-int 5))

 (defn generate-world-from-position
   ""
@@ -108,22 +108,26 @@
   ""
   [state alpha beta timeout is-first-player max-depth grid-width grid-height]
   (if (is-terminal-state state)
-    (get-value-for-state state)
+    [(get-value-for-state state) []]
     (if (= max-depth 0)
-      (heuristic state)
+      [(heuristic state) []]
       (let [best Double/POSITIVE_INFINITY]
         (loop [successor-states (generate-successor-states state grid-width grid-height is-first-player)
                new-alpha alpha
                new-beta beta]
           (if (empty? successor-states)
-            best
-            (let [v (- (negamax-inner (first successor-states) (- new-beta) (- new-alpha) timeout (not is-first-player) (- max-depth 1) grid-width grid-height))]
+            (if (empty? (state true))
+              [best [(long (/ grid-width 2)) (long (/ grid-height 2))]]
+              [best []])
+            (let [successor-state (first successor-states)
+                  [v-temp _] (negamax-inner successor-state (- new-beta) (- new-alpha) timeout (not is-first-player) (- max-depth 1) grid-width grid-height)
+                  v (- v-temp)]
               (if (> v best)
                 (let [new-best v]
                   (if (> new-best new-alpha)
                     (let [ret-alpha best]
                       (if (>= ret-alpha new-beta)
-                        new-best
+                        [new-best (first (clojure.set/difference successor-state state))]
                         (recur (rest successor-states) ret-alpha new-beta)))
                     (recur (rest successor-states) new-alpha new-beta)))
                 (recur (rest successor-states) new-alpha new-beta)))))))))
@@ -132,10 +136,10 @@
   ""
   [is-first-player state timeout grid-width grid-height]
   ; Return if timeout
-  (let [negamax-value (negamax-inner state Double/NEGATIVE_INFINITY Double/POSITIVE_INFINITY timeout is-first-player grid-width grid-height)]
+  (let [[negamax-value move] (negamax-inner state Double/NEGATIVE_INFINITY Double/POSITIVE_INFINITY timeout is-first-player 2 grid-width grid-height)]
     (if is-first-player
-      negamax-value
-      (- (negamax-inner state)))))
+      move
+      (second (negamax-inner state)))))

 (defn -getNextMove
   "Gets the next best move"


fix test description

fix test description

--- test/clj/lambdacd/steps/control_flow_test.clj
+++ test/clj/lambdacd/steps/control_flow_test.clj
@@ -185,7 +185,7 @@
   (testing "that it executes the success-step if the condition is a success"
     (is (map-containing {:outputs {[2 0 0] {:status :success :message :foo}}}
                         ((junction some-successful-step some-step-that-returns-foo some-step-that-returns-bar) {} (some-ctx-with :step-id [0 0])))))
-  (testing "that it executes the success-step if the condition is a success"
+  (testing "that it executes the failure-step if the condition is a failure"
     (is (map-containing {:outputs {[3 0 0] {:status :success :message :bar}}}
                         ((junction some-failing-step some-step-that-returns-foo some-step-that-returns-bar) {} (some-ctx-with :step-id [0 0])))))
   (testing "that it kills all children if it is killed"


Fixed type in context editor plugin

Fixed type in context editor plugin

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

--- src/conexp/contrib/gui/editors/context_editor/context_editor.clj
+++ src/conexp/contrib/gui/editors/context_editor/context_editor.clj
@@ -62,7 +62,7 @@

 (defn-context-changer add-new-object
   "Adds a new object."
-  (make-context (conj (objects context)
+  (make-context (conj (objects ctx)
                       (req-unique-string (objects ctx) "new object"))
                 (attributes ctx)
                 (incidence ctx)))


Fix acquire-and-write-to-disk

Fix acquire-and-write-to-disk

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

--- acqEngine/src/org/micromanager/test/saving.clj
+++ acqEngine/src/org/micromanager/test/saving.clj
@@ -6,6 +6,57 @@
            (java.nio.channels FileChannel$MapMode))
   (:require [org.micromanager.mm :as mm])
   (:use [org.micromanager.mm :only (core)]))
+
+(defn stop []
+  (core stopSequenceAcquisition))
+
+(defn status []
+  {:running (core isSequenceRunning)
+   :remaining-images (core getRemainingImageCount)
+   :overflow (core isBufferOverflowed)
+   :exposure (core getExposure)
+   :camera (core getCameraDevice)
+   :width (core getImageWidth)
+   :height (core getImageHeight)
+   :bytes-per-pixel (core getBytesPerPixel)
+   :image-size (core getImageBufferSize)
+   :roi (mm/get-camera-roi)})
+
+;; bucket brigade
+
+(defn bucket-node [input-queue function output-queue]
+  (future
+    (loop []
+      (let [item (.take input-queue)]
+        (if (= item input-queue)
+          (.put output-queue output-queue)
+          (do (.put output-queue (function item))
+              (recur)))))))
+
+(defn first-node [n function output-queue]
+  (future
+    (dotimes [i n]
+      (.put output-queue (function)))
+    (.put output-queue output-queue)))
+
+(defn last-node [input-queue function]
+  (loop []
+    (let [item (.take input-queue)]
+      (when (not= item input-queue)
+        (function item)
+        (recur)))))
+
+
+(defn bucket-brigade [n & functions]
+  (let [first-queue (LinkedBlockingQueue.)
+        first-node (first-node n (first functions) first-queue)]
+    (loop [remaining-functions (rest functions) input-queue first-queue]
+      (let [f (first remaining-functions)]
+        (if-let [n (next remaining-functions)]
+          (let [output-queue (LinkedBlockingQueue.)]
+            (bucket-node input-queue f output-queue)
+            (recur n output-queue))
+          (last-node input-queue f))))))

 (defn queuify
   "Runs zero-arg function n times on another thread. Returns
@@ -38,8 +89,7 @@
                        (not (core isBufferOverflowed)))
              (Thread/sleep 1))
            (if (pos? (core getRemainingImageCount))
-             (when-let [img (core popNextTaggedImage)]
-               (.getDirectBuffer img))
+             (core popNextTaggedImage)
              (when (core isBufferOverflowed)
                (throw (Exception. "Circular buffer overflowed."))))))

@@ -53,9 +103,7 @@
   (.. ByteBuffer (allocateDirect size-bytes)
       (order (ByteOrder/nativeOrder))))

-(def byte-buffer-memo (memoize byte-buffer))
-
-(defn image-to-byte-buffer
+(defn pixels-to-byte-buffer
   "Store 16-bit image pixel array data in a
    pre-existing byte buffer instance."
   ([pix buffer]
@@ -65,7 +113,7 @@
   ([pix]
     (if (instance? ByteBuffer pix)
       pix
-      (image-to-byte-buffer pix (byte-buffer (* 2 (count pix)))))))
+      (pixels-to-byte-buffer pix (byte-buffer (* 2 (count pix)))))))

 ;; writing to disk
@@ -78,56 +126,59 @@
 (def corePop-memo (memoize #(core popNextImage)))

 (defn acquire-and-write-to-disk [num-images]
-  (let [filename (str "D:/AcquisitionData/deleteMe" (rand-int 100000) ".dat")]
-    (println "\nto disk:" filename)
+  (let [filename (str "G:/acquisition/deleteMe" (rand-int 100000) ".dat")]
+    (-> filename java.io.File. .getParentFile .mkdirs)
+    (run-sequence-acquisition num-images false)
+    (with-open [file (RandomAccessFile. filename "rw")]
+      (time (let [channel (.getChannel file)
+                  image-queue (queuify num-images 50 pop-next-image)
+                  filled-buffer-queue (queuify num-images 50 #(pixels-to-byte-buffer
+                                                               (.pix (.take image-queue))))]
+                       ;(println image-queue filled-buffer-queue)
+                       (dotimes [_ num-images]
+                         (write-buf channel (.take filled-buffer-queue))))))))
+
+(defn acquire-and-write-parallel [num-images]
+  (let [filename (str "E:/acquisition/deleteMe" (rand-int 100000) ".dat")]
+    (println filename)
+    ;(run-sequence-acquisition num-images false)
     (with-open [file (RandomAccessFile. filename "rw")]
                (time (let [channel (.getChannel file)
+                           n (count (core getImage))
                            image-queue (queuify num-images 5 #(core getImage))
-                           filled-buffer-queue (queuify num-images 5 #(image-to-byte-buffer
-                                                                        (.take image-queue)))
+                           empty-buffer-queue (queuify num-images 5 #(byte-buffer (* 2 n)))
+                           filled-buffer-queue (queuify num-images 5 #(pixels-to-byte-buffer
+                                                                        (.pix (.take image-queue))
+                                                                        (.take empty-buffer-queue)))
                            ]
                        ;(println image-queue empty-buffer-queue filled-buffer-queue)
                        (dotimes [_ num-images]
                          (write-buf channel (.take filled-buffer-queue))))))))
-
-
-(defn write-test [num-images]
-  (let [filename (str "D:/AcquisitionData/deleteMe" (rand-int 100000) ".dat")
-        buf (image-to-byte-buffer (core getImage) (byte-buffer (* 2 n)))]
-    (println "\nparallel:" filename)
-    (with-open [file (RandomAccessFile. filename "rw")]
-               (time (let [channel (.getChannel file)]
-                       (dotimes [_ num-images]
-                         (write-buf channel buf)))))))
-
-(defn acquire-and-write-parallel [num-images]
-  (let [filename (str "D:/AcquisitionData/deleteMe" (rand-int 100000) ".dat")]
-    (println "\nparallel:" filename)
-    (with-open [file (RandomAccessFile. filename "rw")]
-               (time (let [channel (.getChannel file)
-                           n (count (core getImage))
-                           image-queue (queuify num-images 5 #(core getImage))
-                           empty-buffer-queue (queuify 10 10 #(byte-buffer (* 2 n)))
-                           filled-buffer-queue (queuify num-images 5 #(image-to-byte-buffer
-                                                                        (.take image-queue)
-                                                                        (.take empty-buffer-queue)))
-                           ]
-                       ;(println image-queue empty-buffer-queue filled-buffer-queue)
-                       (dotimes [_ num-images]
-                         (let [buf (.take filled-buffer-queue)]
-                           (write-buf channel buf)
-                           (.offer empty-buffer-queue buf))))))))

 ;; other tests
+
+(defn test-write [num-images]
+  (let [buffer (byte-buffer (* 2560 2160 2))
+        filename (str "D:/AcquisitionData/test" (rand-int 100000) ".dat")
+        file (RandomAccessFile. filename "rw")
+        channel (.getChannel file)]
+    (println filename)
+    (try
+      (dotimes [i num-images]; 100
+                     (.rewind buffer)
+        (.write channel buffer))
+      (catch Exception e (println e))
+      (finally
+        (.close file)))))

 (defn monitor-circular-buffer []
   (while (not (core isSequenceRunning))
     (Thread/sleep 100))
   (while (core isSequenceRunning)
     (println (core getRemainingImageCount))
-    (Thread/sleep 1000)))
+    (Thread/sleep 250)))

 (defn drain-queue [blocking-queue]
   (future (loop [i 0]


simulate popping including a TaggedImage

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

--- acqEngine/src/org/micromanager/test/saving.clj
+++ acqEngine/src/org/micromanager/test/saving.clj
@@ -40,7 +40,8 @@
                        (not (core isBufferOverflowed)))
              (Thread/sleep 1))
            (if (pos? (core getRemainingImageCount))
-             (core popNextImage)
+             (when-let [img (core popNextTaggedImage)]
+               (.pix img))
              (when (core isBufferOverflowed)
                (throw (Exception. "Circular buffer overflowed."))))))

@@ -102,8 +103,8 @@
   (let [buffer-queue (time (byte-buffer-queue num-images))
         storage-queue (proxy [LinkedBlockingQueue] []
                         (toString [] (str "(" (count this) " items)")))]
-    (dotimes-timed [i num-images] 100
-      (let [buffer (.take buffer-queue)]
-        (.put storage-queue buffer)))
+      (dotimes-timed [i num-images] 100
+        (let [buffer (.take buffer-queue)]
+          (.put storage-queue buffer)))
     storage-queue))


Issue 125 Now you only have to pass in a function that takes two params to specify a cookie policy

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -24,7 +24,10 @@
            (org.apache.http.impl.conn SingleClientConnManager
                                       ProxySelectorRoutePlanner)
            (org.apache.http.auth UsernamePasswordCredentials AuthScope)
-           (org.apache.http.util EntityUtils)))
+           (org.apache.http.util EntityUtils)
+           (org.apache.http.cookie CookieSpecFactory)
+           (org.apache.http.impl.cookie BrowserCompatSpec)))
+

 (defn parse-headers
   "Takes a HeaderIterator and returns a map of names to values.
@@ -84,21 +87,27 @@
         (set-client-param client ConnRoutePNames/FORCED_ROUTE route)))
     request))

+(defn- cookie-spec [f] (proxy [BrowserCompatSpec] []
+                        (validate [cookie origin] (f cookie origin))))
+
+(defn- cookie-spec-factory [f] (proxy [CookieSpecFactory] []
+                           (newInstance [params] (cookie-spec f))))
+
 (defn add-client-params!
   "Add various client params to the http-client object, if needed."
   [http-client kvs]
-  (let [cookie-spec-factory (:cookie-spec-factory kvs)
-        cookie-policy (or
-                        (not-empty (str (class cookie-spec-factory)))
-                        CookiePolicy/BROWSER_COMPATIBILITY)
-        kvs (dissoc kvs :cookie-spec-factory)]
+  (let [cookie-policy (:cookie-policy kvs)
+        cookie-policy-name (str (type cookie-policy))
+        kvs (dissoc kvs :cookie-policy)]
     (when cookie-spec-factory
       (-> http-client
         .getCookieSpecs
-        (.register cookie-policy, cookie-spec-factory)))
+        (.register cookie-policy-name (cookie-spec-factory cookie-policy))))
   (doto http-client
     (set-client-param ClientPNames/COOKIE_POLICY
-                      cookie-policy)
+                      (if cookie-policy
+                        cookie-policy-name
+                        CookiePolicy/BROWSER_COMPATIBILITY))
     (set-client-param CookieSpecPNames/SINGLE_COOKIE_HEADER true)
     (set-client-param ClientPNames/HANDLE_REDIRECTS false))


Route is back working

Route is back working

--- src/cljs/ls/core.cljs
+++ src/cljs/ls/core.cljs
@@ -12,7 +12,8 @@
    [["" :index]
     ["login" :login]
     ["signup" :sign-up]
-    [true :four-o-four]]])
+    [true :four-o-four]]
+   ])

 (defn menu []
   [:div.ui.large.secondary.inverted.pointing.menu
@@ -92,11 +93,9 @@
 (defn init! []
   (accountant/configure-navigation!
     {:nav-handler  (fn
-                     [path]                                 ;;(1)
-                     (let [match (bidi/match-route app-routes path)
-                           current-page (:handler match)
-                           route-params (:route-params match)]
-                       (session/put! :route {:current-page current-page
+                     [path]
+                     (let [{:keys [handler route-params]} (bidi/match-route app-routes path)]
+                       (session/put! :route {:current-page handler
                                              :route-params route-params})))
      :path-exists? (fn [path]
                      (boolean (bidi/match-route app-routes path)))})


Use (dec ..) instead of (- x 1) for decrementing

--- src/govuk/blinken/dashboard.clj
+++ src/govuk/blinken/dashboard.clj
@@ -19,7 +19,7 @@
      [:h2 "Hosts"] [:div "No data"]]))

 (defn- list-alerts [alerts status-class]
-  (let [max-i (- (count alerts) 1)]
+  (let [max-i (dec (count alerts))]
     (map-indexed (fn [i alert]
                    [:tr {:class (str "alert " (if (= i max-i) status-class))}
                     [:td {:class (str "status " status-class)}]


comment path

comment path

--- src/fhir_schema/path.clj
+++ src/fhir_schema/path.clj
@@ -4,8 +4,8 @@
             [clojure.java.io :as io]
             [clojure.walk :as walk]))

-(def parse (antlr/parser
-            (.getPath (io/resource "grammars/fpath.g4"))))
+;; (def parse (antlr/parser
+;;             (.getPath (io/resource "grammars/fpath.g4"))))

 ;; (defn clear [pt]
 ;;   (walk/postwalk (fn [xs]


Fix a tiny problem in production monitoring

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -443,7 +443,7 @@
 (defn production-monitoring
   "Return a csv containing the total audio length of all productions"
   []
-  (response/file-response (psm/csv (prod/find-by-state :structured))))
+  (response/file-response (psm/csv (prod/find-by-state "structured"))))

 (defn login-form []
   (layout/common nil


use exclude

use exclude

--- src/hackerrank/clojure_libs.clj
+++ src/hackerrank/clojure_libs.clj
@@ -49,6 +49,12 @@
 ;; replaces other already loaded functions

 ;; use only
-(use '[clojure.string :only [split]])
+;; (use '[clojure.string :only [split]])
+;; (split "a,b,c" #",")
+;; use only function we needed
+
+;; use exclude
+(use '[clojure.string :exclude [replace reverse]])
 (split "a,b,c" #",")
-;; use only function we needed
+;; eliminates shadowing of name colissions
+;; best: use only with :only


put rollbars on an agent

put rollbars on an agent

--- src/pc/rollbar.clj
+++ src/pc/rollbar.clj
@@ -1,8 +1,9 @@
 (ns pc.rollbar
   (:require [clojure.string :as str]
-            [org.httpkit.client :as http]
+            [clj-http.client :as clj-http]
             [clj-stacktrace.core :refer [parse-exception]]
             [clj-stacktrace.repl :refer [method-str]]
+            [clojure.tools.logging :as log]
             [cheshire.core :as json]
             [pc.profile :as profile]))

@@ -32,14 +33,23 @@
   (json/encode {:access_token access-token
                 :data (apply merge data-maps)}))

+(defonce rollbar-agent (agent nil
+                              :error-mode :continue
+                              :error-handler (fn [a e]
+                                               (log/error "Error in rollbar agent" e)
+                                               (.printStackTrace e))))
+
+(defn send-payload* [_ payload]
+  (clj-http/post endpoint
+                 {:body payload
+                  :content-type :json
+                  :socket-timeout 30000 ; 30s
+                  :conn-timeout 30000   ; 30s
+                  :accept :json}))
+
 (defn send-payload
   [payload]
-  (http/post endpoint
-             {:body payload
-              :content-type :json
-              :socket-timeout 30000     ; 30s
-              :conn-timeout 30000       ; 30s
-              :accept :json}))
+  (send-off rollbar-agent send-payload* payload))

 (defn base-data
   [environment level]


Fix start-up

Fix start-up

--- dev/dev.clj
+++ dev/dev.clj
@@ -29,7 +29,7 @@
 (defn new-dev-system
   "Create a development system"
   []
-  (-> (new-system-map {})
+  (-> (new-system-map)
       (component/system-using (new-dependency-map))))

 (defn init


Add additional validation CATs for valid schemas

--- test/graphql_clj/validator_test.clj
+++ test/graphql_clj/validator_test.clj
@@ -41,7 +41,13 @@
   (= (map :error expected) (->> validated operation-errors (map :error))))

 (deftest default-values-of-correct-type
-  (testing "valid"
+  (testing "valid1"
+    (let [{:keys [result expected]} (nth cats 0)]
+      (is (= expected result))))
+  (testing "valid2"
+    (let [{:keys [result expected]} (nth cats 1)]
+      (is (= expected result))))
+  (testing "valid3"
     (let [{:keys [result expected]} (nth cats 2)]
       (is (= expected result))))
   (testing "default-for-required-field"


Minor cleanup to tests

Minor cleanup to tests

I think the 'and' could potentially hide failures due to
boolean short-circuiting

--- test/hundred_pushups/core_test.cljc
+++ test/hundred_pushups/core_test.cljc
@@ -213,11 +213,14 @@
   (is (= "Monday: 9AM-5PM", (format-whitelist-row [:Monday ["9AM" "5PM"]]))))

 (deftest valid-hour-time-test
-  (is (= false, (valid-hour-time "9not")))
-  (is (= false, (valid-hour-time  "9AM")))
-  (is (= false, (valid-hour-time  "")))
-  (is (= false, (valid-hour-time  nil)))
-  (is (= true, (valid-hour-time  "9am")))
-  (is (= false, (and (valid-hour-time "abc") (valid-hour-time "123"))))
-  (is (= false, (and (valid-hour-time "abc") (valid-hour-time "5pm"))))
-  (is (= true, (and (valid-hour-time "9am") (valid-hour-time "5pm")))))
+  (is (= false (valid-hour-time "9not")))
+  (is (= false (valid-hour-time  "9AM")))
+  (is (= false (valid-hour-time  "")))
+  (is (= false (valid-hour-time  nil)))
+  (is (= true  (valid-hour-time  "9am")))
+  (is (= false (valid-hour-time "abc")))
+  (is (= false (valid-hour-time "123")))
+  (is (= false (valid-hour-time "abc") ))
+  (is (= true  (valid-hour-time "5pm")))
+  (is (= true  (valid-hour-time "9am") ))
+  (is (= true  (valid-hour-time "5pm"))))


Do not shutdown peer groups that have already been shutdown

--- test/onyx/generative/peer_model.clj
+++ test/onyx/generative/peer_model.clj
@@ -543,7 +543,8 @@
                                      @zookeeper-log)]
            (run! (fn [[group-id group]]
                    (try
-                    (pm/action (:state group) [:stop-peer-group])
+                    (when-let [state (:state group)]
+                      (pm/action state [:stop-peer-group]))
                     (catch Throwable t
                       (println t))))
                  final-groups)


Fix assemble-follow-ups call.

Fix assemble-follow-ups call.

--- src/oc/storage/api/activity.clj
+++ src/oc/storage/api/activity.clj
@@ -272,7 +272,7 @@
                              board-uuids (map :uuid boards)
                              board-slugs-and-names (map #(array-map :slug (:slug %) :access (:access %) :name (:name %)) boards)
                              board-by-uuid (zipmap board-uuids board-slugs-and-names)
-                             activity (assemble-follow-ups conn params org board-by-uuid user-id)]
+                             activity (assemble-follow-ups conn params org sort-type board-by-uuid user-id)]
                           (activity-rep/render-activity-list params org "follow-ups" sort-type activity boards user))))

 ;; A resource to retrieve Inbox posts


util/context.clj: doc strings

util/context.clj: doc strings

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

-(defn www-content-dir []
+(defn www-content-dir
+  "Root directory for markdown content files for 'about' pages on
+  www.altlaw.org" []
   (java.io.File. (str (altlaw-home) "/src/org/altlaw/www/content")))

-(defn www-public-dir []
+(defn www-public-dir
+  "Root directory for public files generated by code and served via
+  HTTP on www.altlaw.org" []
   (java.io.File. (str (altlaw-home) "/var/public")))

-(defn www-static-dir []
+(defn www-static-dir
+  "Root directory for public files under version control that are
+  served via HTTP on www.altlaw.org" []
   (java.io.File. (str (altlaw-home) "/src/org/altlaw/www/static")))

-(defn solr-home []
+(defn solr-home
+  "Solr home directory for running Solr instances."
+  []
   (java.io.File. (str (altlaw-home) "/var/solr")))


added functional test for location

added functional test for location

--- test/clj/conference_rating/functional_test.clj
+++ test/clj/conference_rating/functional_test.clj
@@ -4,7 +4,8 @@
             [clojure.test :refer [deftest is testing use-fixtures]]
             [conference-rating.server :as server]
             [clojure.string :as s])
-  (:import (java.util UUID)))
+  (:import (java.util UUID)
+           (org.openqa.selenium Keys)))

 (taxi/set-driver! {:browser :chrome})

@@ -57,8 +58,17 @@
 (defn fill-future-date [e2e-tag]
   (fill-date e2e-tag ".next"))

+(defn fill-location [location]
+  (taxi/send-keys (e2e-selector "input-conference-location") location)
+  (Thread/sleep 1000)
+  (taxi/send-keys (e2e-selector "input-conference-location") Keys/ARROW_DOWN)
+  (taxi/send-keys (e2e-selector "input-conference-location") Keys/ENTER))
+
 (defn text [e2e-tag]
   (taxi/text (e2e-selector e2e-tag)))
+
+(defn value [e2e-tag]
+  (taxi/value (e2e-selector e2e-tag)))

 (defn texts [e2e-tag]
   (map core/text (taxi/find-elements {:css (e2e-selector e2e-tag)})))
@@ -74,6 +84,9 @@
   (let [conference-series (str "some unique series" (UUID/randomUUID))
         past-conference-name (str "some unique conference name" (UUID/randomUUID))
         past-conference-link "www.some-link.org"
+        past-conference-location-search-term "CCH - Congress Center"
+        past-conference-location-name "CCH - Congress Center Hamburg"
+        past-conference-location-address "Am Dammtor / Marseiller Straße, 20355 Hamburg, Germany"
         past-conference-description "some really fancy description with a new line.\nAnd here is the new line. Wohooo!"
         future-conference-name (str "some other unique conference name" (UUID/randomUUID))]

@@ -92,6 +105,7 @@
                    "input-conference-name"        past-conference-name
                    "input-conference-link"        past-conference-link
                    "input-conference-description" past-conference-description})
+      (fill-location past-conference-location-search-term)
       (fill-past-date "date-conference-from")
       (fill-past-date "date-conference-to")
       (click "button-create-conference")
@@ -102,6 +116,8 @@
         (is (= conference-series (s/lower-case (text "text-conference-series")))) ; different chromedrivers treat css transform differently
         (is (= past-conference-name (text "text-conference-name")))
         (is (not-empty (text "text-conference-from-to-dates")))
+        (is (= past-conference-location-name (text "text-conference-location-name")))
+        (is (= past-conference-location-address (text "text-conference-location-address")))
         (is (= past-conference-link (text "text-conference-link")))
         (is (= past-conference-description (text "text-conference-description")))
         (is (= "This conference has not been rated yet. Be the first one to give it your voice!" (text "no-ratings-info")))
@@ -113,6 +129,7 @@
                      "input-conference-name"        future-conference-name
                      "input-conference-link"        "www.some-other-link.org"
                      "input-conference-description" "some other description."})
+        (fill-location "Budapest")
         (fill-future-date "date-conference-from")
         (fill-future-date "date-conference-to")
         (click "button-create-conference")
@@ -122,6 +139,8 @@
         (let [future-conference-url (taxi/current-url)]
           (is (= conference-series (s/lower-case (text "text-conference-series")))) ; different chromedrivers treat css transform differently
           (is (= future-conference-name (s/lower-case (text "text-conference-name"))))
+          (is (= "Budapest" (text "text-conference-location-name")))
+          (is (= "Budapest, Hungary" (text "text-conference-location-address")))
           (is (= "This conference has not started yet and no conference of this series has been rated yet. Come back later!" (text "no-ratings-info")))

           ; navigate to newly created past conference
@@ -151,6 +170,7 @@
           ; edits past conference
           (click "button-edit-conference")
           (wait-for "page-add-conference")
+          (is (= past-conference-location-name (value "input-conference-location")))
           (fill-input {"input-conference-description" "some edited description"})
           (click "button-create-conference")


bus: Send :pages/updated when OCR finished.

--- src/pepa/processor/page_ocr.clj
+++ src/pepa/processor/page_ocr.clj
@@ -64,11 +64,13 @@
       (pdf/with-reader [pdf (:data page)]
         (let [run-ocr (run-ocr-fn (get-in component [:config :ocr]))
               [status text] (pdf/call-with-rendered-page-file pdf (:number page) :png 300 run-ocr)]
-          (db/update! db
-                      :pages
-                      {:ocr_text text
-                       :ocr_status status}
-                      ["id = ?" (:id page)])))))
+          (db/with-transaction [db db]
+            (db/notify! db :pages/updated)
+            (db/update! db
+                        :pages
+                        {:ocr_text text
+                         :ocr_status status}
+                        ["id = ?" (:id page)]))))))

   component/Lifecycle
   (start [component]


did a proper solution, because elements were never removed.

--- src/play_clj/core_listeners.clj
+++ src/play_clj/core_listeners.clj
@@ -191,17 +191,19 @@
         (.setCamera camera)
         (.setWorldSize (. camera viewportWidth) (. camera viewportHeight)))))
   ([{:keys [^Stage renderer ui-listeners]} [entities]]
-   (doseq [^Actor a (.getActors renderer)]
-     #_(.remove a))
-   (doseq [e (vals entities) ]
-     (let [object (:object e)]
-       (when (isa? (type object) Actor)
-         (when-not (.hasParent object)
-           (.addActor renderer object))
+     (let [actor-set (->> entities
+                          vals
+                          (map :object)
+                          (filter #(isa? (type %) Actor))
+                          set)]
+       (doseq [^Actor a (clojure.set/difference (set (.getActors renderer)) actor-set )]
+         (.remove a))
+       (doseq [object (clojure.set/difference actor-set (set (.getActors renderer)) ) ]
+         (.addActor renderer object)
          (doseq [[_ listener] ui-listeners]
-           (.addListener ^Actor object listener)))))
-   (remove-input! renderer)
-   (add-input! renderer)))
+           (.addListener ^Actor object listener)))
+       (remove-input! renderer)
+       (add-input! renderer))))

 (defmulti update-physics!
   (fn [screen & [entities]] (some-> screen :world class .getName))


DatomicConnection works now fine

DatomicConnection works now fine

--- modules/datomic/src/modular/datomic.clj
+++ modules/datomic/src/modular/datomic.clj
@@ -39,15 +39,15 @@
       (->EphemeralDatabase uri)
       (->DurableDatabase uri))))

-(defrecord DatomicConnection [connection]
+(defrecord DatomicConnection []
   component/Lifecycle
   (start [this] (assoc this :connection (d/connect (get-in this [:database :uri]))))
-  (stop [this] (d/release connection) (dissoc this :connection)))
+  (stop [this] (d/release (:connection this)) (dissoc this :connection)))

-(defn new-datomic-connection
+(defn new-datomic-connection []
   (component/using
-   (->DatomicConnection nil)
-   [:database]))
+    (->DatomicConnection)
+    [:database]))

 (defrecord DatomicSchema [res]
   component/Lifecycle


Correct one of the RMS example descriptions

--- src/devcards/audio_utils/devcards/rms_buffer.cljs
+++ src/devcards/audio_utils/devcards/rms_buffer.cljs
@@ -95,16 +95,17 @@
     (plot-buffers 1250 "Input" data "RMS Values" rms-values)))

 (defcard
-  "500 zeros, 100 1.0s and 2400 zeros along with RMS values
+  "500 zeros, 100 1.0s and 1400 zeros along with RMS values
    calculated after adding each individual sample to an RMS
-   buffer with size 1000. Starting with the 1.0s, the RMS
-   value quickly rises but never reaches 1.0s due to the
-   large RMS buffer window size. After the 1.0s it slowly
-   decreases again until the RMS buffer is full. From this
-   point, the ratio of 0.0s to 1.0s in the RMS window remains
-   the same (resulting in a constant RMS value) until the
-   RMS window slides out of the 100 1.0s, resulting in a
-   decrease down to an RMS value of 0.0. This final decrease
+   buffer with a window size of 1000 samples.
+
+   Starting with the 1.0s, the RMS value quickly rises but
+   never reaches 1.0s due to the large RMS buffer window size.
+   After the 1.0s it slowly decreases again until the RMS buffer
+   is full. From this point, the ratio of 0.0s to 1.0s in the RMS
+   window remains the same (resulting in a constant RMS value)
+   until the RMS window slides out of the 100 1.0s, resulting in
+   a decrease down to an RMS value of 0.0. This final decrease
    takes exactly 100 samples (corresponding to the 1.0s)."
   (let [data        (concat (repeat 500 0.0)
                             (repeat 100 1.0)


Turns out has-source-package is not a good enough keep-class? heuristic.

Fixes #139.

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -205,16 +205,23 @@

 (defn- has-source-package?
   "Test if the class file's package exists as a directory in :source-path."
-  [project f]
-  (.isDirectory (file (.replace (.getParent f)
-                                (:compile-path project)
-                                (:source-path project)))))
+  [project f source-path]
+  (and source-path (.isDirectory (file (.replace (.getParent f)
+                                                 (:compile-path project)
+                                                 source-path)))))
+
+(defn- keep-class? [project f]
+  (or (has-source-package? project f (:source-path project))
+      (has-source-package? project f (:java-source-path project))
+      (.exists (file (str (.replace (.getParent f)
+                                    (:compile-path project)
+                                    (:source-path project)) ".clj")))))

 (defn delete-non-project-classes [project]
   (when (and (not= :all (:aot project))
              (not (:keep-non-project-classes project)))
     (doseq [f (file-seq (file (:compile-path project)))
-            :when (and (.isFile f) (not (has-source-package? project f)))]
+            :when (and (.isFile f) (not (keep-class? project f)))]
       (.delete f))))

 (defn- status [code msg]