About to delete stub factories

About to delete stub factories

--- src/angelic/search/implicit/dash_astar.clj
+++ src/angelic/search/implicit/dash_astar.clj
@@ -18,6 +18,42 @@
 ;; TODO: stub has link back to parent SP
 ;; TODO: How are subsumption links handled?
 ;; What if we create tree summarizer with stub ? ? ?   ?  ?? ? ?  ?  ? ?
+
+;; TODO: add pess
+
+;; TODO: propagate top-down-bounds downward in smarter way using existing IS?
+;; TODO: we need to make sure tree sums get called on add-output! first to ensure
+;;       consistency with top-down-bounds ?
+;; TODO: top-down bound business does not actually help at all
+
+;;  (except ensuring consistency if we're asserting it...)
+;; When we create a stub, we also get: tree summarizer, subsumption-thing.
+;; (subsumption-children are parent tree-summarizers).
+;; Subsumption-thing is subsumption-child of stub, summarizer, tree-summarizer.
+;; Tree-summarizers also remember best bound, this gives us consistency
+;; How do they pass to children, though?
+;; Apparent cycle -- tree summarizer has children that are child tree-summarizers,
+;; And, these children should have the parent TS as a subsumption child.
+;; Key: this is only to preserve info from original SP, subsumption..
+;; This info should go into subsumption-thing.
+;; Subsumption-thing is just ordinary max over children, + self, + TS?
+;; ->>(We rely on eager updates to make sure it gets updated?)
+
+;; TDB should not actually go into TS, children should be directly bounded?
+;; All children, including inner SP, should do it fine.
+;; This means that every thing has exactly one subsumption parent ... which is nice.
+;; How does consistency get approached ?
+;; We just have the cycle, but would be great if we didn't have to go in child --> ts --> st --> children
+;; cycle every time things to up -- maybe ST just doesn't update ord. parents.
+;; TODO: figure this out later.
+
+
+;; Can goall the way down to nearest sum, I guess...
+;; Subsumer gets attached to subsumer of any child (or inner child?)
+
+;; What do we do about multiple ways to express a given plan ? ? ? ?
+;; Can normalize or not, interesting question... start without.
+

 (set! *warn-on-reflection* true)

@@ -64,26 +100,104 @@
   (summaries/connect! p c false)
   (add-watcher! c f))

+(defn- get-stub-output  [s] (first (get-outputs s)))
+(defn- get-stub-output! [s] (util/safe-singleton (get-outputs s)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;      Tree Summarizers      ;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Every child of TS is also a subsumption parent.
+;; Then, TS has:
+;; Children:
+;;  Ordinary: stub, SP, TS of outputs
+;;  Subsuming: Subsuming TS's
+;; Parents:
+;;  Ordinary: whoever
+;;  Subsuming: stub, SP, TS of outputs,
+;; Note alternative: separate TS and ST - -but cycle is needed for memory, no matter what?.
+
+;; TODO: fix cycles by making subsumption updates only happen when strictly < reward.
+;; TODO: what updates are needed here?
+(defn- make-tree-summarizer [stub]
+  (let [bound-atom (atom 0)
+        ret (traits/reify-traits [summaries/simple-cached-node]
+              summaries/Summarizable
+              (summarize [s]
+                (let [s (summaries/or-summary s @bound-atom)]
+                  (reset! bound-atom (summary/max-reward s))
+                  s)))
+        sp-watch! (fn [sp]
+                   (summaries/connect! sp ret true)
+                   (connect-and-watch! ret sp
+                     (fn [child-sp]
+                       (let [child-ts (tree-summarizer (stub child-sp))]
+                         (summaries/connect! ts child-ts false)
+                         (summaries/connect! child-ts ts true)
+                         (summaries/summary-changed! ts)))))]
+    (if-let [sp (get-stub-output stub)]
+      (sp-watch! sp)
+      (do (summaries/connect! stub ts true)
+          (connect-and-watch! ts stub sp-watch!)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;     StubFactories     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; TODO: is there a distinction between SF and subsumption meeting place?
+;; Latter can use, e.g., normalized sequences?
+;; As-is, is there any need for SF at all ?
+
+(defprotocol StubFactory
+  (sf-name [sf])
+  (get-stub [sf inp-set subsuming-sp]))
+
+(defn make-simple-stub-factory [nm make-stub]
+  (let [] ;    h (HashMap.)
+    (reify StubFactory
+      (sf-name [sf] nm)
+      (get-stub [sf inp-set subsuming-sp]
+        (let [stub (make-stub sf inp-set subsuming-sp)]
+          (when subsuming-sp (add-subsuming-sp! stub subsuming-sp))
+          stub)))))
+
+ ;;        (util/cache-with h inp-set (make-stub inp-set)))
+
+(defmulti make-stub-factory (fn [nm] (first nm)))
+
+(def *sf-cache* nil)
+
+(defn get-stub-factory [nm]
+  (util/cache-with ^HashMap *sf-cache* nm (make-stub-factory nm)))
+
+(defn get-stub-by-name [nm is] (get-stub (get-stub-factory nm) is nil))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Stubs     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;; Stub must implement Summarizable, optionally implements Evaluable
+
 (defprotocol Stub
-  (stub-name   [s])
-  (input-set   [s]))
-
-(traits/deftrait simple-stub [name inp] [] [watched-node]
-  Stub (input-set [s] inp)
-       (stub-name [s] name))
+  (stub-factory    [s])
+  (input-set       [s])
+  (tree-summarizer [s] "Summarizer that includes outputs/children."))
+
+(defprotocol Evaluable (evaluate! [s]))
+
+(defn stub-name [s] (sf-name (stub-factory s)))
+
+(traits/deftrait simple-stub [sf inp] [ts-atom (atom nil)] [watched-node]
+  Stub
+  (stub-factory    [s] sf)
+  (input-set       [s] inp)
+  (tree-summarizer [s] (or @ts-atom (reset! ts-atom (make-tree-summarizer s)))))

 (defmethod print-method angelic.search.implicit.dash_astar.Stub [s o]
   (print-method (format "#<ST$%8h %s>" (System/identityHashCode s) (stub-name s)) o))

-;; Stub must implement Summarizable, optionally implements Evaluable
-
-(defprotocol Evaluable (evaluate! [s]))
-(defn- can-evaluate? [s] (instance? angelic.search.implicit.dash_astar.Evaluable s))
+(defn- add-subsuming-sp! [stub subsuming-sp]
+  (summaries/connect! (tree-summarizer stub) (tree-summarizer (stub subsuming-sp)) true))

 (defn- set-stub-output! [stub sp]
   (assert (empty? (get-outputs stub)))
@@ -91,11 +205,7 @@
   (add-output! stub sp))

-(defn- get-stub-output  [s] (first (get-outputs s)))
-(defn- get-stub-output! [s] (util/safe-singleton (get-outputs s)))
-
-;; Just give output directly if subproblem is ready
-;; Return true if waiting
+;; Just give output directly if subproblem is ready; return true if waiting
 (defn- connect-and-watch-stub! [p c f]
   (assert (instance? angelic.search.implicit.dash_astar.Stub c))
   (if-let [sp (get-stub-output c)]
@@ -108,8 +218,8 @@
 (defn- connect-and-watch-stub-up! [p c f]
   (when (connect-and-watch-stub! p c f) (summaries/summary-changed! p)))

-(defn- make-wrapping-stub [[name in-set] inner-stub sp-fn]
-  (let [ret (traits/reify-traits [summaries/or-summarizable (simple-stub name in-set)])]
+(defn- make-wrapping-stub [[sf in-set] inner-stub sp-fn]
+  (let [ret (traits/reify-traits [summaries/or-summarizable (simple-stub sf in-set)])]
     (connect-and-watch-stub! ret inner-stub #(set-stub-output! ret (sp-fn ret %)))
     ret))

@@ -122,276 +232,129 @@
 (defprotocol Subproblem
   (stub              [s])
   (output-set        [s])
-  (tree-summarizer   [s] "Summarizer that includes children.")
   (terminal?         [s] "Subproblem will not return any outputs.")
   (refine-input      [s refined-input-set] "Return a child stub."))

-(defn- subproblem-name [s] (stub-name (stub s)))
+(defn- sp-name [s] (stub-name (stub s)))
+(defn- sp-sf [s] (stub-factory (stub s)))

 (defmethod print-method angelic.search.implicit.dash_astar.Subproblem [sp o]
-  (print-method (format "#<SP$%8h %s>" (System/identityHashCode (stub sp)) (subproblem-name sp)) o))
-
-
-(defn- connect-subsuming! [child subsuming-sp]
-  (when subsuming-sp (summaries/connect! child (tree-summarizer subsuming-sp) true)))
+  (print-method (format "#<SP$%8h %s>" (System/identityHashCode (stub sp)) (sp-name sp)) o))

 (defn- add-sp-child! [sp child-sp]
   (assert (not (terminal? sp)))
   (summaries/summary-changed-local! sp)
   (add-output! sp child-sp))

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Tree Summarizer  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-;; TODO: propagate top-down-bounds downward in smarter way using existing IS?
-;; TODO: we need to make sure tree sums get called on add-output! first to ensure
-;;       consistency with top-down-bounds ?
-;; TODO: top-down bound business does not actually help at all
-
-;;  (except ensuring consistency if we're asserting it...)
-;; When we create a stub, we also get: tree summarizer, subsumption-thing.
-;; (subsumption-children are parent tree-summarizers).
-;; Subsumption-thing is subsumption-child of stub, summarizer, tree-summarizer.
-;; Tree-summarizers also remember best bound, this gives us consistency
-;; How do they pass to children, though?
-;; Apparent cycle -- tree summarizer has children that are child tree-summarizers,
-;; And, these children should have the parent TS as a subsumption child.
-;; Key: this is only to preserve info from original SP, subsumption..
-;; This info should go into subsumption-thing.
-;; Subsumption-thing is just ordinary max over children, + self, + TS?
-;; ->>(We rely on eager updates to make sure it gets updated?)
-
-;; TDB should not actually go into TS, children should be directly bounded?
-;; All children, including inner SP, should do it fine.
-;; This means that every thing has exactly one subsumption parent ... which is nice.
-;; How does consistency get approached ?
-;; We just have the cycle, but would be great if we didn't have to go in child --> ts --> st --> children
-;; cycle every time things to up -- maybe ST just doesn't update ord. parents.
-;; TODO: figure this out later.
-
-
-;; Can goall the way down to nearest sum, I guess...
-;; Subsumer gets attached to subsumer of any child (or inner child?)
-
-;; What do we do about multiple ways to express a given plan ? ? ? ?
-;; Can normalize or not, interesting question... start without.
-
-(defprotocol TreeSummarizer
-  (top-down-bound    [s])
-  (add-top-down-bound! [s b]))
-
-(defn- tree-summarizer? [s] (instance? angelic.search.implicit.dash_astar.TreeSummarizer s))
-
-(defn- make-tree-summarizer [init-bound]
- (let [tdb-atom (atom  init-bound)]
-   (traits/reify-traits [summaries/simple-cached-node]
-     TreeSummarizer (top-down-bound [s] @tdb-atom)
-                    (add-top-down-bound! [s b]
-                      (when (< b @tdb-atom) ;; ;; Note: adding < current max-reward actually hurts...
-                        (reset! tdb-atom b)
-                        (doseq [c (summaries/node-ordinary-children s)]
-                          (when (tree-summarizer? c)
-                            (add-top-down-bound! c b)))
-                        (summaries/summary-changed! s)))
-     summaries/Summarizable (summarize [s] (summaries/or-summary s  @tdb-atom)))))
-
-(defn- init-tree-summarizer! [ts inner-sp subsuming-sp]
-  (connect-and-watch! ts inner-sp
-    (fn [child-sp]
-      (summaries/connect! ts (tree-summarizer child-sp) false)
-      (add-top-down-bound! (tree-summarizer child-sp) (top-down-bound ts))
-      (summaries/summary-changed! ts))) ;; TODO: speedup by checking child reward?
-  (connect-subsuming! ts subsuming-sp))
-
-(defn- get-inner-sp [ts]
-  (->> (summaries/node-ordinary-children ts)
-       (remove tree-summarizer?)
-       util/safe-singleton))
-
-(defn- ts-str [sp])
-(defmethod print-method angelic.search.implicit.dash_astar.TreeSummarizer [ts o]
-  (let [stub (stub (get-inner-sp ts))]
-    (print-method (format "#<TS$%8h %s>" (System/identityHashCode stub) (stub-name stub)) o)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Subproblem Impl  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(traits/deftrait simple-subproblem [stb out-set ts term? ri-fn] [] [watched-node]
+(traits/deftrait simple-subproblem [stb out-set term? ri-fn] [] [watched-node]
   Subproblem (stub            [s] stb)
              (output-set      [s] out-set)
-             (tree-summarizer [s] ts)
              (terminal?       [s] term?)
              (refine-input    [s ni] (ri-fn s ni)))

-
-(defn- make-simple-subproblem [stub subsuming-sp out-set terminal? summary-fn ri-fn init-bound]
-  (let [ts  (make-tree-summarizer init-bound)
-        ret (traits/reify-traits [(simple-subproblem stub out-set ts terminal? ;; Note ni may have different context.
-                                                     (fn [s ni] (if (= ni (input-set stub)) stub (ri-fn s ni))))]
-              summaries/Summarizable (summarize [s] (summary-fn s (top-down-bound ts))))]
-    (init-tree-summarizer! ts ret subsuming-sp)
-    ret))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     Wrappers     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;     Output Collection     ;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(declare make-output-collecting-subproblem)
-(defn- make-output-collecting-stub [inner-stub]
-  (assert (not (= (first (stub-name inner-stub)) :OS)))
-  (assert (not (= (first (stub-name inner-stub)) :SA)))
-  (make-wrapping-stub
-   [[:OS (stub-name inner-stub)] (input-set inner-stub)]
-   inner-stub make-output-collecting-subproblem))
-
-
-(defn- =-state-sets [s1 s2]
-  (util/assert-is (= (state/current-context s1) (state/current-context s2)) "%s" [s1 s2])
-  (= s1 s2))
-
-(defn- make-output-collecting-subproblem [stb inner-sp]
-  (let [;        counter (HashMap.)
-        ts  (tree-summarizer inner-sp)
-        ret (traits/reify-traits
-             [(simple-subproblem stb (output-set inner-sp) ts false
-                                 #(doto (if (= (input-set stb) %2) stb (refine-input inner-sp %2)) ;Needed when SA off
-                                    (-> stub-name first #{:SA :OS} assert)))]
-             summaries/Summarizable (summarize [s] (summaries/or-summary s (top-down-bound ts))))]
-    (connect-and-watch! ret inner-sp
-      (fn child-watch [o]
-        (if (=-state-sets (output-set inner-sp) (output-set o))
-          (do (connect-and-watch! ret o child-watch)
-              (summaries/summary-changed! ret))
-          (do #_ (let [c (.get counter (input-set (stub o)))]
-                (when c (println c (stub-name (stub o))))
-                (.put counter (input-set (stub o)) (inc (or c 0))))
-
-              (if (#{:SA :OS} (first (subproblem-name o)))
-                (add-sp-child! ret o)
-                (connect-and-watch-stub! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %))))))) ;; No update needed
-    ret))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;     State Abstraction     ;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(declare make-state-abstracted-subproblem)
-(defn- make-eager-state-abstracted-stub [inner-stub in-set]
-  (make-wrapping-stub [[:SA (stub-name inner-stub)] in-set] inner-stub make-state-abstracted-subproblem))
-
-
-(defn- make-deliberate-state-abstracted-stub [inner-stub in-set]
-  (if-let [out (get-stub-output inner-stub)]
-    (let [done? (atom false)
-          ret
-          (traits/reify-traits
-           [(simple-stub [:SA (stub-name inner-stub) in-set] in-set)]
-           summaries/Summarizable
-           (summarize [s]
-            (if @done? summary/+worst-simple-summary+
-                (summary/make-live-simple-summary
-                 (summary/max-reward (summaries/summary (tree-summarizer out))) s)))
-           Evaluable
-           (evaluate! [s] (reset! done? true)
-            (set-stub-output! s (make-state-abstracted-subproblem s out))))]
-      (summaries/connect! ret out false)
-      ret)
-    (make-eager-state-abstracted-stub inner-stub in-set)))
-
-
-(defn- make-state-abstracted-stub [inner-stub in-set]
-  ((case *state-abstraction*
-     :eager make-eager-state-abstracted-stub
-     :deliberate make-deliberate-state-abstracted-stub)
-   inner-stub in-set))
-
-
-;; Note: subsumed subproblems can have different irrelevant vars
-(defn- make-state-abstracted-subproblem [stb inner-sp]
-  (let [ts  (tree-summarizer inner-sp)
-        in  (input-set stb)
-        out (state/transfer-effects in (output-set inner-sp))
-        ri-fn #(if (=-state-sets %2 in) stb (refine-input inner-sp %2))
-        ret (traits/reify-traits
-             [summaries/or-summarizable (simple-subproblem stb out ts (terminal? inner-sp) ri-fn)])]
-    (connect-and-watch! ret inner-sp
-      (fn [o] (connect-and-watch-stub-up! ret (make-state-abstracted-stub (stub o) in) #(add-sp-child! ret %))))
-    ret))
+;; Note: summary-fn should take subsuming-bound into account.
+(defn- make-simple-subproblem [stub out-set terminal? summary-fn ri-fn]
+  (traits/reify-traits
+   [(simple-subproblem stub out-set ts terminal? ;; Note ni may have different context.
+                       (fn [s ni] (if (= ni (input-set stub)) stub (ri-fn s ni))))]
+   summaries/Summarizable (summarize [s] (summary-fn s 0))))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;     Core Subproblems     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Names       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defn atomic-name [fs] [:Atomic fs])
+(defn pair-name [l r] [:Pair l r])
+
+(defn left-factor [s]
+  (loop [s (next s) ret (first s)]
+    (if s
+      (recur (next s) (pair-name ret (first s)))
+      ret)))
+
+(defn right-factor [[f & r]]
+  (if (seq r)
+    (pair-name f (right-factor r))
+    f))
+
+(defn- make-fs-seq-name [fs-seq]
+  (assert (seq fs-seq))
+  ((if *left-recursive* left-factor right-factor)
+   (map atomic-name fs-seq)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Atomic       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (declare make-fs-seq-stub get-atomic-stub)

-(defn- make-atomic-subproblem [stub function-set subsuming-sp out-set reward status]
-  (let [inp-set  (input-set stub)
-        ri-fn    (fn [s ri] (get-atomic-stub s ri function-set))]
+(defn- make-atomic-subproblem [stb out-set reward status subsuming-sp]
+  (let [inp-set  (input-set stb)
+        ri-fn    (fn [s ri] (get-stub (stub-factory stb) inp-set s))]
     (cond (not (= status :live))
           (make-simple-subproblem
-           stub subsuming-sp out-set true
-           (fn [s b] (summary/make-simple-summary (min b reward) status s)) ri-fn reward)
+           stb out-set true
+           (fn [s b] (summary/make-simple-summary (min (subsuming-bound s) b reward) status s)) ri-fn)

           (and subsuming-sp (not (terminal? subsuming-sp)))
-          (let [ret (make-simple-subproblem stub subsuming-sp out-set false summaries/or-summary ri-fn reward)]
+          (let [ret (make-simple-subproblem stb subsuming-sp out-set false summaries/or-summary ri-fn)]
             (connect-and-watch! ret subsuming-sp
               (fn [sub-out]
                 (connect-and-watch-stub-up! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))))
             ret)

-          :else
-          (let [ret (make-simple-subproblem stub subsuming-sp out-set false summaries/or-summary ri-fn reward)]
-            (doseq [child (map #(make-fs-seq-stub inp-set %) (fs/child-seqs function-set inp-set))]
-              (connect-and-watch-stub! ret child #(add-sp-child! ret %)))
+          :else ;; TODO
+          (let [ret (make-simple-subproblem stb out-set false summaries/or-summary ri-fn)]
+            (doseq [child-name (map make-fs-seq-name (fs/child-seqs function-set inp-set))]
+              (connect-and-watch-stub! ret (get-stub-by-name child-name inp-set)
+                 #(add-sp-child! ret %)))
             ret))))

 ;; Note: this is double-stage to lazily generate children.  Could be simpler single-stage.
-(defn- make-atomic-stub [name subsuming-sp inp-set function-set]
-  (let [state (atom :ready) ;; set to [out-set reward] after first eval, then :go after second.
-        ret
-        (traits/reify-traits [(simple-stub name inp-set)]
-         summaries/Summarizable
-         (summarize [s]
-           (cond (= :ready @state) (summary/make-live-simple-summary (summaries/subsuming-bound s) s)
-                 (= :go    @state) summary/+worst-simple-summary+
-                 :else             (summary/make-live-simple-summary
-                                    (min (summaries/subsuming-bound s) (second @state)) s)))
-         Evaluable
-         (evaluate! [s]
-           (assert (not (= :go @state)))
-           (let [ready? (= :ready @state)]
-             (if-let [[out-set reward :as op] (if ready? (fs/apply-opt function-set inp-set) @state)]
-               (let [status (if ready? (fs/status function-set inp-set)   :live)]
-;                 (println "eval" s ready? status reward)
-                 (if (or (not ready?) (not (= status :live)))
-                   (do (reset! state :go)
-                       (->> (make-atomic-subproblem s function-set subsuming-sp out-set reward status)
-                            (set-stub-output! s)))
-                   (do (reset! state op) (summaries/summary-changed! s))))
-               (do (reset! state :go) (summaries/summary-changed! s))))))]
-    (connect-subsuming! ret subsuming-sp)
-    ret))
-
-;; Note: we must always wrap in S-A stub to get effects out of logger.
-(defn- get-atomic-stub [subsuming-sp inp-set function-set]
-  (let [full-name [:Atomic (fs/fs-name function-set)
-                   (if *state-abstraction* (fs/extract-context function-set inp-set) inp-set)]
-        make-stub #(let [r (make-atomic-stub [:Atomic (fs/fs-name function-set)] subsuming-sp % function-set)]
-                     (if *collect-equal-outputs* (make-output-collecting-stub r) r))]
-    (if-let [^HashMap dc *decompose-cache*]
-      (if *state-abstraction*
-        (let [stub (util/cache-with dc full-name (make-stub (fs/get-logger function-set inp-set)))]
-          (make-state-abstracted-stub stub inp-set))
-        (util/cache-with dc full-name (make-stub inp-set)))
-     (make-stub inp-set))))
+(defn- make-atomic-stub [sf inp-set subsuming-sp]
+  (let [state (atom :ready)]  ;; set to [out-set reward] after first eval, then :go after second.
+    (traits/reify-traits [(simple-stub sf inp-set)]
+      summaries/Summarizable
+      (summarize [s]
+       (cond (= :ready @state) (summary/make-live-simple-summary (summaries/subsuming-bound s) s)
+             (= :go    @state) summary/+worst-simple-summary+
+             :else             (summary/make-live-simple-summary
+                                (min (summaries/subsuming-bound s) (second @state)) s)))
+      Evaluable
+      (evaluate! [s]
+        (assert (not (= :go @state)))
+        (let [fs     (second (sf-name sf))
+              ready? (= :ready @state)]
+          (if-let [[out-set reward :as op] (if ready? (fs/apply-opt fs inp-set) @state)]
+            (let [status (if ready? (fs/status fs inp-set)   :live)]
+              (if (or (not ready?) (not (= status :live)))
+                (do (reset! state :go)
+                    (->> (make-atomic-subproblem s subsuming-sp out-set reward status)
+                         (set-stub-output! s)))
+                (do (reset! state op) (summaries/summary-changed! s))))
+            (do (reset! state :go) (summaries/summary-changed! s))))))))
+
+(defmethod make-stub-factory :Atomic [[_ fs :as n]]
+  (make-simple-stub-factory n make-atomic-stub))
+
+;; TODO: subsuming-sp should get connected to atomic-stub outside of make-atomic-stub
+;; (since it may already exist)!
+;; Note: we must always wrap in S-A stub to get effects out of logger.
+(comment
+ (defn- get-atomic-stub [subsuming-sp inp-set function-set]
+   (let [full-name [:Atomic (fs/fs-name function-set)
+                    (if *state-abstraction* (fs/extract-context function-set inp-set) inp-set)]
+         make-stub #(let [r (make-atomic-stub [:Atomic (fs/fs-name function-set)] subsuming-sp % function-set)]
+                      (if *collect-equal-outputs* (make-output-collecting-stub r) r))]
+     (if-let [^HashMap dc *decompose-cache*]
+       (if *state-abstraction*
+         (let [stub (util/cache-with dc full-name (make-stub (fs/get-logger function-set inp-set)))]
+           (make-state-abstracted-stub stub inp-set))
+         (util/cache-with dc full-name (make-stub inp-set)))
+       (make-stub inp-set)))))

@@ -400,16 +363,13 @@

 (declare make-pair-stub1 make-pair-stub2)

-;; NOTE: subsumption doesn't seem to help
-;; TODO: fix up subsuming, parent, etc.
-;; nils at bottom should chase subsuming-sp.
 ;; Note: this is the only place logic depends on summary.  Potential for problems?
-(defn- make-pair-subproblem [subsuming-sp pair-stub left-sp right-sp]
+(defn- make-pair-subproblem [sf left-sp right-sp]
   (let [expand-right? (and (summary/solved? (summaries/summary left-sp)) (empty? (get-outputs left-sp)))
         kids (if expand-right? [(tree-summarizer left-sp) right-sp] [left-sp (tree-summarizer right-sp)])
         ss   (summaries/make-sum-summarizer kids)
         ret (make-simple-subproblem
-             pair-stub subsuming-sp (output-set right-sp) false
+             pair-stub (output-set right-sp) false
              (if (or expand-right? (not *collect-equal-outputs*)) summaries/or-summary
                  (let [left-done? (atom false)] ;; Manually take into account left-solved, when no output message.
                    (fn [s b]
@@ -419,15 +379,12 @@
                         ;; Make sure we don't double count, because child will use tree-summarizer of left.
                        (add-watcher! left-sp (fn [o] (def *sum* [s left-sp o])
                                                (throw (RuntimeException. "Solved and children."))))
-                       (connect-and-watch-stub! s (make-pair-stub2 subsuming-sp left-sp (stub right-sp))
-                                           (fn [os] (connect-and-watch! s os #(add-sp-child! s %))))) ;; no update needed
+                       (connect-and-watch-stub! s (make-pair-stub2 sf left-sp (stub right-sp))
+                          (fn [os] (connect-and-watch! s os #(add-sp-child! s %))))) ;; no update needed
                      (summaries/or-summary s b))))
              (fn [s ri] (make-pair-stub1 s (refine-input left-sp ri)
-                          (subproblem-name right-sp) #(refine-input right-sp %)))
-             0)]
-
+                          (sp-name right-sp) #(refine-input right-sp %))))]
     (summaries/connect! ret ss false)
-
     (let [[watch stub-f] (if expand-right?
                            [right-sp #(make-pair-stub2 nil left-sp (stub %))]
                            [left-sp #(make-pair-stub2 nil % (refine-input right-sp (output-set %)))])]
@@ -435,66 +392,39 @@
          (fn [o]
            (summaries/summary-changed-local! ss)
            (connect-and-watch-stub-up! ret (stub-f o) #(add-sp-child! ret %)))))
-
     ret))

-(comment
-  ;; Old test used this -- do we need to split on right for blocked left?
-  (not (summary/live? (summaries/summary left-sp)))
- (not (= Double/NEGATIVE_INFINITY (summary/max-reward (summaries/summary left-sp)))))
-
-(defn- make-pair-stub2 [subsuming-sp left-sp right-stub]
-  (let [nm [:Pair (subproblem-name left-sp) (stub-name right-stub)]
-        is (input-set (stub left-sp))]
+
+(defn- make-pair-stub2 [sf left-sp right-stub]
+  (let [is (input-set (stub left-sp))]
     (if (get-stub-output right-stub) ;; short-circuit the mess below
-      (doto (make-wrapping-stub [nm is] right-stub #(make-pair-subproblem subsuming-sp %1 left-sp %2))
+      (doto (make-wrapping-stub [sf is] right-stub #(make-pair-subproblem %1 left-sp %2))
         (-> get-stub-output assert)) ;; summary of wrapping stub would be wrong, otherwise...
-      (let [ret (traits/reify-traits [summaries/sum-summarizable (simple-stub nm is)])]
-        (connect-subsuming! ret subsuming-sp)
+      (let [ret (traits/reify-traits [summaries/sum-summarizable (simple-stub sf is)])]
         (summaries/connect! ret (tree-summarizer left-sp) false)
         (connect-and-watch-stub! ret right-stub
-            #(set-stub-output! ret (make-pair-subproblem subsuming-sp ret left-sp %)))
+            #(set-stub-output! ret (make-pair-subproblem ret left-sp %)))
         ret))))

-(defn- make-pair-stub1 [subsuming-sp left-stub right-name right-stub-fn]
+;; Note, potential to learn about additioan lsubsumption here, however, must be taken into account.
+(defn- make-pair-stub1 [sf left-stub right-stub-fn]
   (if-let [left-sp (get-stub-output left-stub)]
-    (make-pair-stub2 subsuming-sp left-sp (right-stub-fn (output-set left-sp)))
-   (let [nm [:Pair1 (stub-name left-stub) right-name]
-         is (input-set left-stub)
-         ret (traits/reify-traits [summaries/or-summarizable (simple-stub nm is)])]
-     (connect-subsuming! ret subsuming-sp)
+    (make-pair-stub2 sf left-sp (right-stub-fn (output-set left-sp)))
+   (let [ret (traits/reify-traits [summaries/or-summarizable (simple-stub sf (input-set left-stub))])]
      (connect-and-watch-stub! ret left-stub
        (fn [lo]
          (connect-and-watch-stub-up! ret
-           (make-pair-stub2 subsuming-sp lo (right-stub-fn (output-set lo)))
+           (make-pair-stub2 sf lo (right-stub-fn (output-set lo)))
            #(set-stub-output! ret %))))
      ret)))

-
-;; Experimental version -- switched order.
-(defn- make-left-recursive-fs-seq-stub
-  ([inp-set fs] (make-left-recursive-fs-seq-stub inp-set fs (map fs/fs-name fs)))
-  ([inp-set [first-fs & rest-fs] fs-names]
-     (loop [left-stub (get-atomic-stub nil inp-set first-fs) rest-fs rest-fs fs-names (rest fs-names)]
-       (if (empty? rest-fs)
-         left-stub
-         (recur (make-pair-stub1 nil left-stub (first fs-names) #(get-atomic-stub nil % (first rest-fs)))
-                (rest rest-fs) (rest fs-names))))))
-
-(defn- make-right-recursive-fs-seq-stub
-  ([inp-set fs] (make-right-recursive-fs-seq-stub inp-set fs (map fs/fs-name fs)))
-  ([inp-set [first-fs & rest-fs] fs-names]
-     (let [left-stub (get-atomic-stub nil inp-set first-fs)]
-       (if (empty? rest-fs)
-         left-stub
-         (make-pair-stub1 nil left-stub (rest fs-names)
-                          #(make-right-recursive-fs-seq-stub % rest-fs (rest fs-names)))))))
-
-(defn- make-fs-seq-stub [inp-set fs]
-  ((if *left-recursive* make-left-recursive-fs-seq-stub make-right-recursive-fs-seq-stub)
-   inp-set fs))
-
-
+(defmethod make-stub-factory :Pair [[_ left-name right-name :as n]]
+  (let [left-sf  (get-stub-factory left-name)
+        right-sf (get-stub-factory right-name)]
+    (make-simple-stub-factory n
+      (fn [sf inp sub-sp]
+        (make-pair-stub1 sf (get-stub left-sf inp) #(get-stub right-sf %))))))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Planning ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -520,7 +450,8 @@
   (when s (assert d))
   (when d (assert gather))
 ;  (assert (contains? #{:uncached :lazy :eager  :eager-nosub :eager-nokids} c))
-  (binding [*collect-equal-outputs* gather
+  (binding [*sf-cache*              (HashMap.)
+            *collect-equal-outputs* gather
             *decompose-cache*       (when d (HashMap.))
             *state-abstraction*     s
             *left-recursive*        (= dir :left)
@@ -529,7 +460,7 @@
     (summaries/solve
      (tree-summarizer (apply get-root-subproblem (fs/make-init-pair henv)))
      choice-fn local? evaluate!
-     #(let [n (second (subproblem-name %))] (when-not (= (first n) :noop) n)))))
+     #(let [n (second (sp-name %))] (when-not (= (first n) :noop) n)))))

 ;; (do (use '[angelic env hierarchy] 'angelic.domains.nav-switch 'angelic.search.implicit.fah-astar-expand 'angelic.search.implicit.fah-astar-eval 'angelic.search.implicit.dash-astar 'angelic.domains.discrete-manipulation) (require '[angelic.search.explicit.hierarchical :as his]))

@@ -549,22 +480,3 @@

-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Graveyard ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(comment
-  (defn pseudo-solve [root-sp]
-   (summaries/pseudo-solve root-sp summary/+worst-simple-summary+ (complement summaries/expanded?)
-                           #(if (evaluated? %) (do (assert (not (summaries/expanded? %))) (child-keys %)) (evaluate! %))))
-
-
-  (defn implicit-fah-a*-eval-pseudo [henv]
-  (->> (fs/make-init-pair henv)
-       (apply make-simple-atomic-subproblem nil)
-       subproblem/pseudo-solve)))
-
-
-


more parse debugging

more parse debugging

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -14,9 +14,10 @@

 (def map-fn #?(:clj pmap) #?(:cljs map))

-(defn over [grammar left right]
+(defn over [grammar left right morph]
   "opportunity for additional logging before calling the real (over)"
   (log/trace (str "parse/over: grammar size: " (count grammar)))
+  (log/debug (str "parse/over: left: " (morph left) "; right: " (morph right)))
   (over/over grammar left right))

 (defn square-cross-product [x]
@@ -106,7 +107,7 @@
                                   (lazy-cat
                                    (if (and (not (empty? left-signs))
                                             (not (empty? right-signs)))
-                                     (over (:grammar model) left-signs right-signs))
+                                     (over (:grammar model) left-signs right-signs (:morph model)))

                                  ;; TODO: explain why we can use (first) here for the left- and right-strings.
                                    ;; Throw an exception if (> 1 (count left-strings)) or (> 1 (count right-strings))


more logging

more logging

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -139,6 +139,7 @@
 (defn parse [input model]
   "return a list of all possible parse trees for a string or a list of lists of maps
    (a result of looking up in a dictionary a list of tokens from the input string)"
+  (log/info (str "parsing input: '" input "'"))
   (let [tokens (string/split input tokenizer)
         token-count (count tokens)
         token-count-range (range 0 token-count)
@@ -146,7 +147,7 @@
                                token-count-range)
                           (map (fn [i] [(nth tokens i)])
                                token-count-range))]
-    (log/debug (str "input map: " input-map))
+    (log/debug (str "input map:" input-map))
     (let [all-parses
           (parses input-map token-count model
                   (span-map token-count))
@@ -156,5 +157,8 @@
            (filter map? (get all-parses
                              [0 token-count]))
            :all-parses all-parses}]
+      (if (empty? (:complete-parses result))
+        (log/warn (str "could not parse: " input))
+        (log/info (str "successfully parsed input: '" input "'")))
       (:complete-parses result))))


remove debugging code

remove debugging code

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -215,9 +215,6 @@
                                            "; used source semantics:" source-semantics ".")]
                           (log/error message)
                           (throw (Exception. message))))
-                      (log/info (str "RESULT: " result))
-                      (log/info (str "TYPE OF target_structure:"
-                                     (type (get result :target_structure))))
                       (let [show-target-structures false ;; true for debugging
                             retval
                             (-> result


+ (json-read-str) to read input json correctly

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -2,6 +2,7 @@
   [:refer-clojure :exclude [get-in resolve]]
   [:require
    [babel.korma :as korma]
+   [clojure.string :as string]
    [clojure.data.json :as json :refer [read-str write-str]]
    [clojure.tools.logging :as log]
    [compojure.core :as compojure :refer [GET PUT POST DELETE ANY]]
@@ -16,6 +17,7 @@
 (declare generate)
 (declare generate-question-and-correct-set)
 (declare id2expression)
+(declare json-read-str)

 ;; web service that translates babel.reader's API and an HTTP client.
 (def routes
@@ -28,21 +30,16 @@
                   source-locale "US"
                   target "it"
                   target-locale "IT"
-                  target-spec
-                  (read-str (if-let [target-spec (get (:query-params request) "target-spec")]
-                              target-spec ""))
-                  game-spec
-                  {:target_spec {:root {:italiano {:italiano "decidere"}}
-                                 :synsem {:sem {:tense :past
-                                                :aspect :perfect}}}
-                   :source_spec :top}
+                  target_spec
+                  (json-read-str (if-let [target_spec (get (:query-params request) "target_spec")]
+                              target_spec "{}"))
                   ]
               (write-str {:source "some english stuff..."
-                          :target-spec target-spec
+                          :target_spec target_spec
                           :g-q-a-c-s
                           (try
                             (generate-question-and-correct-set
-                             (:target_spec game-spec)
+                             target_spec
                              source source-locale
                              target target-locale)
                             (catch Exception e
@@ -55,8 +52,8 @@

       (GET "/:expr" request
            (let [expr (:expr (:route-params request))]
-             (log/info (str "expr(1):" expr))
-             (log/info (str "expr(2):" (Integer. expr)))
+             (log/debug (str "expr(1):" expr))
+             (log/debug (str "expr(2):" (Integer. expr)))
              {:status 200
               :headers {"Content-Type" "application/json;charset=utf-8"}
               :body (write-str (id2expression (Integer. expr)))}))))
@@ -344,5 +341,25 @@
              :structure (deserialize (read-string (:serialized x)))})
           results))))

-
-
+;; TODO: document why we need this
+;; TODO: verbcoach should use this, not config/json-read-str
+;; TODO: move this to babel/globals.cljc or something similar
+(defn json-read-str [json]
+  (json/read-str json
+                 :key-fn keyword
+                 :value-fn (fn [k v]
+                             (cond
+                              (and (or (= k :english)
+                                       (= k :espanol)
+                                       (= k :français)
+                                       (= k :italiano))
+                                   (not (map? v)))
+                              (str v)
+
+                              (and (string? v)
+                                   (= (nth v 0) \:))
+                              (keyword (string/replace-first v ":" ""))
+
+                              (string? v)
+                              (keyword v)
+                              :else v))))


add constraints based on target expression to improve speed for generating source expression

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -144,6 +144,11 @@
         (unify/strip-refs ;; TODO: consider removing strip-refs; not clear if there is any reason why we need to do it.
          (unify/unify
           {:synsem {:sem (unify/get-in target-expression [:synsem :sem])}}
+          (cond
+            (= true (unify/get-in target-expression [:comp :synsem :pronoun]))
+            {:comp {:phrasal false
+                    :synsem {:pronoun true}}}
+            true :top)
           basic-spec))

         ;; TODO: catch possible deref NPE exception that can happen when model is not yet loaded.


insert 'spec' column into expression table

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -146,7 +146,7 @@
     {:source source-language-sentence
      :target target-language-sentence}))

-(defn insert-expression [expression surface table language model-name]
+(defn insert-expression [expression surface spec table language model-name]
   "Insert an expression into the given table. The information to be added will be:
    1. the surface form of the expression
    2. The JSON representation of the expression (the structure)
@@ -160,14 +160,16 @@
    The serialized column allows loading a desired expression as a Clojure map into the runtime system, including
    the expression' internal structure-sharing."

+  (log/debug (str "inserting expression: spec=" spec))
   (try
-    (exec-raw [(str "INSERT INTO " table " (surface, structure, serialized, language, model) VALUES (?,"
-                    ;; TODO: dissoc the spec per immediately below TODO
-                    "$$" (json/write-str (strip-refs expression)) "$$" ;; TODO: store the :spec in a new column 'spec' within the given table.
-                    ","
-                    "$$[" (string/join "" (serialize expression)) "]$$" ;; TODO: check for presence of "$$" within (serialize expression).
-                    ","
-                    "?,?)")
+    (exec-raw [(let [insert
+                     (str "INSERT INTO " table " (surface, structure, spec, serialized, language, model) VALUES (?,"
+                          "$$" (json/write-str (strip-refs expression)) "$$,"
+                          "$$" (json/write-str (strip-refs spec)) "$$,"
+                          "$$[" (string/join "" (serialize expression)) "]$$," ;; TODO: check for presence of "$$" within (serialize expression).
+                          "?,?)")]
+                 (log/trace (str "INSERT IS : " insert))
+                 insert)
                [surface
                 language
                 model-name]])
@@ -175,7 +177,7 @@
       (log/error (str "SQL error: " (.printStackTrace (.getNextException(.getSQLException e))))))))

 (defn insert-lexeme [canonical lexeme language]
-  (log/debug (str "insert-lexeme: canonical=" canonical ",lexeme=" lexeme ",language=" language))
+  (log/trace (str "insert-lexeme: canonical=" canonical ",lexeme=" (strip-refs lexeme) ",language=" language))
   (if (fail? lexeme)
     (let [message (str "Refusing to enter a :fail for canonical form: " canonical)]
       (log/error message)
@@ -214,6 +216,11 @@
   	      	      (if source-language
   	    	        (fo sentence :source-language source-language)
                        (fo sentence)))]
+        (if (nil? sentence)
+          (let [warn-mesg (str "No sentence could be generated in language: " language " with spec:"
+                               spec)]
+            (log/error warn-mesg)
+            (throw (Exception. (str warn-mesg)))))
         (if (empty? surface)
           (let [warn-mesg (str "Surface was empty for expression generated from spec: " spec)]
             (log/error (str "sentence: " sentence))
@@ -225,6 +232,7 @@
                        spec "'"))
         (insert-expression sentence ;; underlying structure
                            surface ;; text of expression
+                           spec
                            "expression" ;; table in database
                            language
                            (:name model)) ;; name of language model; e.g.: 'small','medium'
@@ -267,11 +275,10 @@

             ]

-        (log/info (str target-language ": '"
-                        target-sentence-surface
-                        "'"))
+        (log/info (str target-language ": '" target-sentence-surface "'"))
         (insert-expression target-sentence ;; underlying structure
                            target-sentence-surface ; surface string
+                           spec
                            "expression" ;; table
                            target-language
                            (:name target-language-model)) ;; name, like 'small','medium', etc.
@@ -281,6 +288,7 @@
                         "'"))
         (insert-expression source-sentence
                            source-sentence-surface
+                           spec
                            "expression"
                            source-language
                            (:name source-language-model))))))
@@ -516,6 +524,7 @@
                                                    (let [spec (unify spec
                                                                      {:comp {:synsem {:agr {:number number}}}})]
                                                      (log/debug (str "generating from spec: " spec "; input-spec was:" input-spec))
+                                                     (log/error (str "PROCESS: FILL-ONE-LANGUAGE: SPEC:" spec))
                                                      (try
                                                        (process [{:fill-one-language
                                                                   {:count 1


remove reference to removed babel.francais.grammar/small

--- test/babel/test/parse.cljc
+++ test/babel/test/parse.cljc
@@ -1,8 +1,7 @@
 (ns ^{:doc "Parsing Testing Code"}
     babel.test.parse
   (:refer-clojure :exclude [get-in])
-  (:require [babel.francais.grammar :refer [small medium]]
-            [babel.francais.lexicon :refer [lexicon]]
+  (:require [babel.francais.lexicon :refer [lexicon]]
             [babel.francais.morphology :refer [analyze fo]]
             [babel.over :as over]
             [babel.parse :refer [parse tokenizer]]


Print stacktrace to stdout/err on main error handler.

--- src/uxbox/frontend/routes.clj
+++ src/uxbox/frontend/routes.clj
@@ -38,6 +38,7 @@

 (defn- error-handler
   [context err]
+  (.printStackTrace err)
   (if (instance? clojure.lang.ExceptionInfo err)
     (let [message (.getMessage err)
           data (ex-data err)]


Minor ns macro reorganization on ui.viewer ns.

--- src/uxbox/view/ui/viewer.cljs
+++ src/uxbox/view/ui/viewer.cljs
@@ -6,15 +6,12 @@
 ;; Copyright (c) 2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>

 (ns uxbox.view.ui.viewer
-  (:require [sablono.core :refer-macros [html]]
-            [goog.dom :as gdom]
-            [lentes.core :as l]
-            [rum.core :as rum]
+  (:require [lentes.core :as l]
             [promesa.core :as p]
             [uxbox.util.i18n :refer (tr)]
             [uxbox.util.rstore :as rs]
             [uxbox.util.router :as rt]
-            [uxbox.util.mixins :as mx :include-macros true]
+            [uxbox.util.mixins :as mx]
             [uxbox.main.ui.icons :as i]
             [uxbox.main.state :as st]
             [uxbox.view.data.viewer :as dv]


Remove caching experiment

Remove caching experiment

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -429,12 +429,6 @@
                                    "If this option is selected, then CircleCI will run builds for this project "
                                    "on Mac OSX rather than Linux. Select this if you have an iOS application "
                                    "that you want to build using CircleCI."]})
-            (describe-flag {:flag :smart-cocoapods-caching
-                           :title "Smart CocoaPods Caching"
-                           :blurb [:p
-                                   "Enable caching of CocoaPods to remove the need to call the `pod install`
-                                   command on every build."]})
-
             ]]])))))

 (defn dependencies [project-data owner]


Remove scheduler? predicate (seems buggy on rxjs).

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -634,21 +634,16 @@
 ;; Schedulers
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn ^boolean scheduler?
-  "Return true if `s` is scheduler instance."
-  [s]
-  (js/Rx.Scheduler.isScheduler s))
-
 (def ^:static asap js/Rx.Scheduler.default)
 (def ^:static queue js/Rx.Scheduler.currentThread)
 (def ^:static immediate js/Rx.Scheduler.immediate)

 (defn observe-on
   [scheduler ^observable ob]
-  {:pre [(observable? ob) (scheduler? scheduler)]}
+  {:pre [(observable? ob)]}
   (.observeOn ob scheduler))

 (defn subscribe-on
   [scheduler ^observable ob]
-  {:pre [(observable? ob) (scheduler? scheduler)]}
+  {:pre [(observable? ob)]}
   (.subscribeOn ob scheduler))


Use task-id instead of calling .getThisTaskId

--- src/clj/backtype/storm/daemon/executor.clj
+++ src/clj/backtype/storm/daemon/executor.clj
@@ -516,7 +516,7 @@
                                                  [root (bit-xor id ack-val)])
                            ))
                        (let [delta (tuple-time-delta! tuple)]
-                         (task/apply-hooks user-context .boltAck (BoltAckInfo. tuple (.getThisTaskId user-context) delta))
+                         (task/apply-hooks user-context .boltAck (BoltAckInfo. tuple task-id delta))
                          (when delta
                            (stats/bolt-acked-tuple! executor-stats
                                                     (.getSourceComponent tuple)
@@ -529,7 +529,7 @@
                                                ACKER-FAIL-STREAM-ID
                                                [root]))
                        (let [delta (tuple-time-delta! tuple)]
-                         (task/apply-hooks user-context .boltFail (BoltFailInfo. tuple (.getThisTaskId user-context) delta))
+                         (task/apply-hooks user-context .boltFail (BoltFailInfo. tuple task-id delta))
                          (when delta
                            (stats/bolt-failed-tuple! executor-stats
                                                      (.getSourceComponent tuple)


Various improvements

Various improvements

- solution-only is simpler
- Wiping out temp-dir when done
- :reload-all

--- jvm-runner/src/clojure/codewars/runners/clojure.clj
+++ jvm-runner/src/clojure/codewars/runners/clojure.clj
@@ -7,7 +7,7 @@
   (:refer-clojure :exclude (add-classpath)))

 (defn- add-classpath
-  "Add a url path to the system class loader"
+  "Add a URL path to the system class loader"
   [new-classpath]
   (let [field (aget (.getDeclaredFields java.net.URLClassLoader) 0)]
     (.setAccessible field true)
@@ -16,20 +16,19 @@

 (defmethod solution-only "clojure"
   [{:keys [:setup :solution]}]
-  (let [dir (TempDir/create "clojure")
-        solution-file (io/file dir "solution.clj")]
-    (when (not (empty? setup)) (util/write-code! "clojure" dir setup))
-    (spit solution-file solution)
-    (add-classpath dir)
-    (load-file (str solution-file))))
+  (when (not (empty? setup))
+    (load-string setup))
+  (load-string solution))

 (defmethod full-project "clojure"
   [{:keys [:setup :solution :fixture]}]
   (let [dir (TempDir/create "clojure")
         {fixture-ns :class-name}
         (util/write-code! "clojure" dir fixture)]
-    (when (not (empty? setup)) (util/write-code! "clojure" dir setup))
-    (util/write-code! "clojure" dir solution)
-    (add-classpath dir)
-    (require fixture-ns)
-    (codewars.clojure.test/run-tests fixture-ns)))
+    (try
+      (when (not (empty? setup)) (util/write-code! "clojure" dir setup))
+      (util/write-code! "clojure" dir solution)
+      (add-classpath dir)
+      (require fixture-ns :reload-all)
+      (codewars.clojure.test/run-tests fixture-ns)
+      (finally (TempDir/delete dir)))))


fix handle submit

fix handle submit

--- labs/architecture-examples/om/src/todomvc/item.cljs
+++ labs/architecture-examples/om/src/todomvc/item.cljs
@@ -13,12 +13,12 @@
 ;; Todo Item

 (defn handle-submit [e todo {:keys [owner chans]}]
-  (let [val (.trim (dom/get-node todo "editText"))]
+  (let [val (.trim (dom/get-node owner "editText"))]
     (if-not (string/blank? val)
       (go
-        (>! (:on-save chans) [todo val])
+        (>! (:save chans) [todo val])
         (om/replace! todo :title (:edit-text todo)))
-      (put! (:on-destroy chans) (:id todo)))
+      (put! (:destroy chans) todo))
     false))

 (defn handle-edit [e todo {:keys [owner chans]}]


Fix `set-refresh-dirs`

Fix `set-refresh-dirs`

--- test/global_test_setup.clj
+++ test/global_test_setup.clj
@@ -3,7 +3,7 @@

 (def set-refresh-dirs
   (try
-    (require '[refactor-nrepl.inlined-deps.toolsnamespace.v1v1v0.clojure.tools.namespace.repl :refer [set-refresh-dirs]])
+    (require '[refactor-nrepl.inlined-deps.toolsnamespace.v1v1v0.clojure.tools.namespace.repl])
     @(resolve 'refactor-nrepl.inlined-deps.toolsnamespace.v1v1v0.clojure.tools.namespace.repl/set-refresh-dirs)
     (catch Exception _
       (require '[clojure.tools.namespace.repl])


Duplicate the print-and-braille items when generating txt and fo output

from the repl

--- src/catalog/repl.clj
+++ src/catalog/repl.clj
@@ -15,7 +15,9 @@
   [year issue out]
   (->
    (db/read-catalog year issue)
-   vubis/order-and-group
+   vubis/order
+   vubis/duplicate-print-and-braille-items
+   vubis/group
    (layout.fop/generate-document :all-formats year issue nil nil out)))

 (defn neu-in-grossdruck-fop
@@ -35,7 +37,9 @@
   [year issue]
   (->
    (db/read-catalog year issue)
-   vubis/order-and-group
+   vubis/order
+   vubis/duplicate-print-and-braille-items
+   vubis/group
    (layout.text/text {:year year :issue issue})))

 (defn custom-text


added color querying and setting functions available for turtle programs; tweaked loop macro to do runtime dispatch on condition type;

--- src/clojure/org/turtle/geometry/TurtleGraphics.clj
+++ src/clojure/org/turtle/geometry/TurtleGraphics.clj
@@ -1089,7 +1089,20 @@
             (stop-if-interrupted)
             (swap! (.state activity) assoc-in
                    [:turtle-state :angle]
-                   new-heading))]
+                   new-heading))
+
+          (use-color
+            ([new-color]
+               (stop-if-interrupted)
+               (swap! (.state activity) assoc-in
+                      [:turtle-state :color]
+                      new-color))
+            ([r g b]
+               (use-color (Color/argb 0xff r g b))))
+
+          (get-color []
+            (stop-if-interrupted)
+            (get-in @activity [:turtle-state :color]))]
     (let [turtle-thread
           (Thread.
            (.getThreadGroup (Thread/currentThread))
@@ -1113,6 +1126,18 @@
                  (intern sandbox-ns 'pen-up pen-up)
                  (intern sandbox-ns 'pen-down pen-down)

+                 (intern sandbox-ns 'use-color use-color)
+                 (intern sandbox-ns 'get-color get-color)
+
+                 (intern sandbox-ns 'red (Color/argb 0xff 0xdc 0x32 0x2f))
+                 (intern sandbox-ns 'orange (Color/argb 0xff 0xcb 0x4b 0x16))
+                 (intern sandbox-ns 'yellow (Color/argb 0xff 0xb5 0x89 0x00))
+                 (intern sandbox-ns 'green (Color/argb 0xff 0x85 0x99 0x00))
+                 (intern sandbox-ns 'cyan (Color/argb 0xff 0x2a 0xa1 0x98))
+                 (intern sandbox-ns 'blue (Color/argb 0xff 0x26 0x8b 0xd2))
+                 (intern sandbox-ns 'violet (Color/argb 0xff 0x6c 0x71 0xc4))
+                 (intern sandbox-ns 'magenta (Color/argb 0xff 0xd3 0x36 0x82))
+
                  (intern sandbox-ns 'cos (fn [x] (Math/cos (deg->rad x))))
                  (intern sandbox-ns 'sin (fn [x] (Math/sin (deg->rad x))))
                  (intern sandbox-ns 'rcos (fn [x] (Math/cos (double x))))
@@ -1137,18 +1162,15 @@
                                       {:macro true
                                        :arglists '([invokation _ cond & body])})
                          (fn iter [invokation _ condition & body]
-                           (cond (number? condition)
-                                 `(dotimes [_# ~condition]
-                                    ~@body)
-                                 :else
-                                 `(loop []
+                           `(let [res# ~condition]
+                              (if (number? res#)
+                                (dotimes [_# res#]
+                                  ~@body)
+                                (when res#
+                                  (loop []
+                                    ~@body
                                     (when ~condition
-                                      ~@body
-                                      (recur)))
-                                 ;; (throw (RuntimeException.
-                                 ;;         (format "invalid condition in repeat loop: %s"
-                                 ;;                 cond)))
-                                 )))
+                                      (recur))))))))

                  (binding [*ns* sandbox-ns]
                    (use '[clojure.core])


temporary commit

temporary commit

--- src/clojure/org/turtle/geometry/TurtleGraphics.clj
+++ src/clojure/org/turtle/geometry/TurtleGraphics.clj
@@ -94,16 +94,17 @@

 ;;;;

-(defn log-func
-  ([msg]
-     ;; do nothing in release
-     (android.util.Log/d "TurtleGeometry" msg))
-  ([msg & args] (log-func (apply format msg args))))
+;; do nothing in release
+;; (defn log-func
+;;   ([msg]
+;;      (android.util.Log/d "TurtleGeometry" msg))
+;;   ([msg & args] (log-func (apply format msg args))))

 (defmacro log
   ([msg]
      ;; do nothing in release
-     `(android.util.Log/d "TurtleGeometry" ~msg))
+     ;; `(android.util.Log/d "TurtleGeometry" ~msg)
+     )
   ([msg & args] `(log (format ~msg ~@args))))

 (defmacro draw-with-page-transform [canvas-var transform-matrix & body]
@@ -1263,14 +1264,18 @@
                                 (let [x (aget args 0)]
                                   (rad->deg x))))

-                 "log" (proxy [Procedure] [1 Integer/MAX_VALUE]
-                              (apply [^objects args]
-                                (let [arglist (scheme-list->clojure-list
-                                                 (Pair. (aget args 0)
-                                                        (aget args 1)))]
-                                  ;; (log "original arglist = %s" (vec args))
-                                  ;; (log "converted arglist = %s" (vec arglist))
-                                  (apply log-func arglist))))}
+                 ;; do nothing in release
+                 ;; "alog" (proxy [Procedure] [1 Integer/MAX_VALUE]
+                 ;;          (apply [^objects args]
+                 ;;            ;; (let [arglist (scheme-list->clojure-list
+                 ;;            ;;                (Pair. (aget args 0)
+                 ;;            ;;                       (aget args 1)))]
+                 ;;            ;;   ;; (log "original arglist = %s" (vec args))
+                 ;;            ;;   ;; (log "converted arglist = %s" (vec arglist))
+                 ;;            ;;   ;; (apply log-func arglist)
+                 ;;            ;;   )
+                 ;;            false))
+                 }
           constants {"red" (Color/argb 0xff 0xdc 0x32 0x2f)
                      "orange" (Color/argb 0xff 0xcb 0x4b 0x16)
                      "yellow" (Color/argb 0xff 0xb5 0x89 0x00)


HTTP service listen in all available interfaces

* By default the Immutant web server only listens in localhost

--- backend/src/org/akvo/dash/component/http.clj
+++ backend/src/org/akvo/dash/component/http.clj
@@ -10,7 +10,9 @@
   (start [component]
     (if (:server component)
       component
-      (let [options (-> component (dissoc :app))
+      (let [options (-> component
+                        (dissoc :app)
+                        (assoc :host "0.0.0.0"))
             handler (:handler app)
             server (web/run
                      (fn [req] (handler req)) options)]


Version 0.4.36

Version 0.4.36

--- core/project.clj
+++ core/project.clj
@@ -1,4 +1,4 @@
-(defproject gorillalabs.tesla/core "0.4.36-SNAPSHOT"
+(defproject gorillalabs.tesla/core "0.4.36"
             :plugins [[lein-modules "0.3.11"]]
             :description "basic microservice."
             :dependencies [[mount "0.1.10"]


Add handler for probe metadata (clinical)

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -612,18 +612,20 @@
         sfname (fs/file dir "scores.tmp")
         jfname (fs/file dir "joins.tmp")]
     (try
-      (with-open
-        [probes-file (io/writer pfname)
-         scores-file (io/writer sfname)
-         joins-file (io/writer jfname)]
-        (f {:insert-probe (partial insert-probe-out probes-file probes-seq)
-               :insert-score (partial insert-scores-out scores-file scores-seq)
-               :insert-join (partial insert-joins-out joins-file)
-               :encode (fn [scores] (let [s (score-encode scores)] {:scores s :hex (bytes->hex s)}))
-               :key #(ahashable (:scores (first %)))}))
-      (time (do (read-from-tsv "probes" pfname "PID" "EID" "NAME")
-                (read-from-tsv "scores" sfname "ID" "SCORES")
-                (read-from-tsv "joins" jfname "PID" "I" "SID")))
+      (let [finish
+            (with-open
+              [probes-file (io/writer pfname)
+               scores-file (io/writer sfname)
+               joins-file (io/writer jfname)]
+              (f {:insert-probe (partial insert-probe-out probes-file probes-seq)
+                  :insert-score (partial insert-scores-out scores-file scores-seq)
+                  :insert-join (partial insert-joins-out joins-file)
+                  :encode (fn [scores] (let [s (score-encode scores)] {:scores s :hex (bytes->hex s)}))
+                  :key #(ahashable (:scores (first %)))}))]
+        (do (read-from-tsv "probes" pfname "PID" "EID" "NAME")
+          (read-from-tsv "scores" sfname "ID" "SCORES")
+          (read-from-tsv "joins" jfname "PID" "I" "SID"))
+        (finish))
       (finally
         (fs/delete pfname)
         (fs/delete sfname)


One more test case for General Sorted Sets

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

--- src/conexp/contrib/tests/dl/util/general_sorted_sets.clj
+++ src/conexp/contrib/tests/dl/util/general_sorted_sets.clj
@@ -14,13 +14,21 @@

 ;;;

-(defn- no-equivalent-elements []
+(deftest- adds-elements-in-correct-order
+  (are [order elts] (let [gss-seq (seq-on (make-general-sorted-set order elts))]
+		      (forall [x elts, y elts]
+			(=> (order x y)
+			    (some #(= % y) (drop-while #(not= % x) gss-seq)))))
+       <= [1 2 3 4 5 6 7 8 9],
+       subset? [#{} #{1} #{2} #{3} #{1 2 3} #{1 2} #{1 2 3 4}]))
+
+(deftest- no-equivalent-elements
   (are [num order elts] (= num (count (seq-on (make-general-sorted-set order elts))))
        4 <= [1 2 3 4 4 3 2 1],
-       4 subset? [#{} #{1} #{2} #{1 2} #{2} #{1 2} #{}]
+       4 subset? [#{} #{1} #{2} #{1 2} #{2} #{1 2} #{}],
        6 subset? [#{1} #{2} #{3} #{4} #{1 3} #{3 4} #{1} #{2}]))

-(defn- finds-correct-neighbours []
+(deftest- finds-correct-neighbours
   (are [order elts new-elt lowers uppers] (let [gss (make-general-sorted-set order elts)]
 					    (and (= (set lowers)
 						    (set (map :node
@@ -28,19 +36,19 @@
 						 (= (set uppers)
 						    (set (map :node
 							      (@#'conexp.contrib.dl.util.general-sorted-sets/find-upper-neighbours gss new-elt))))))
-       <= [1 2 4 5] 3 [2] [4]
+       <= [1 2 4 5] 3 [2] [4],
        subset? [#{} #{1} #{2} #{3} #{1 2 3} #{1 2}] #{1 2 3 4} [#{1 2 3}] []))

-(defn- correct-hasse-graph []
+(deftest- correct-hasse-graph
   (are [order elts edges] (let [gss (make-general-sorted-set order elts)]
 			    (= (set edges) (set (hasse-graph gss))))
-       <= [1 2 3 4 5] [[1 2] [2 3] [3 4] [4 5]]
+       <= [1 2 3 4 5] [[1 2] [2 3] [3 4] [4 5]],
        subset? [#{} #{1} #{2} #{3} #{1 2 3} #{1 2} #{1 2 3 4}]
                [[#{} #{1}] [#{} #{2}] [#{} #{3}]
 		[#{1} #{1 2}] [#{2} #{1 2}] [#{1 2} #{1 2 3}]
 		[#{3} #{1 2 3}] [#{1 2 3} #{1 2 3 4}]]))

-(defn- containment []
+(deftest- containment
   (are [order elts no-elts] (let [gss (make-general-sorted-set order elts)]
 			      (and (forall [elt elts]
 					   (contained-in-gss? gss elt))
@@ -51,6 +59,7 @@
                [#{4} #{1 3 4} #{5} #{2 3 4}]))

 (deftest test-general-sorted-sets
+  (adds-elements-in-correct-order)
   (no-equivalent-elements)
   (finds-correct-neighbours)
   (correct-hasse-graph)


Add floor, ceiling, extent functions to c2.maths.

--- src/clj/c2/maths.clj
+++ src/clj/c2/maths.clj
@@ -17,10 +17,17 @@
 (defn log [x] (Math/log x))
 (defn log10 [x] (Math/log10 x))

+(defn floor [x] (Math/floor x))
+(defn ceil [x] (Math/ceil x))
+
 (defn percentage [x y]
   (str (* 100 (/ x y)) "%"))

-
+(defn extent
+  "Returns 2-vector of min and max elements in xs"
+  [xs]
+  [(apply min xs)
+   (apply max xs)])

 ;;element-by-element arithmetic
 ;;Code modified from Incanter


[Add] fun model-check

[Add] fun model-check

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -241,6 +241,15 @@
                    eva))
           (reduce +-exp)
           (exp-result)))))
+
+(defn model-check
+  "At first make model from dataset as a train-dataset, then it validate accuracy of model using dataset as a test-dataset."
+  ([dataset L]
+   {:pre [(instance? DataSet dataset) (integer? L)]
+    :post [(map? %)]}
+   (p :model-check
+      (let [norm-dataset (DataSet. (:classes dataset) (data/normalize (:features dataset)))]
+        (train-to-eval L norm-dataset norm-dataset)))))

 (defn -main [& args]
   {:pre [(string? (first args))]}


add empty?

add empty?

--- src/chartem.clj
+++ src/chartem.clj
@@ -16,7 +16,6 @@
 ;;
 ;;  TODO: matchers list
 ;; -- ** Matchers on seqs
-;; , is-empty
 ;; , has-size
 ;; , every-item
 ;; , include?
@@ -44,7 +43,16 @@
   [a]
   {:match (fn [b] (= a b))
    :description (str "(= " (pr-str a) ")")
-   :describe-mismatch (fn [b] (pr-str b))})
+   :describe-mismatch pr-str})
+
+(def empty?
+  "matches if the collection passed is empty
+
+  (chartem/run-match chartem/empty? [1]) ; => passes
+  (chartem/run-match chartem/empty? [])  ; => fails"
+  {:match empty?
+   :description "(empty?)"
+   :describe-mismatch pr-str})

 (defn format-message
   "turns the results of a failing match into a human readable error message,


change schedule-form to form-2 style, use r/atoms

Since pikaday is so picky about updating state,
use local state atoms for pikaday components
and use atom watches to update the backend state

--- src/cljs/early_vote_site/early_vote_site_detail/views.cljs
+++ src/cljs/early_vote_site/early_vote_site_detail/views.cljs
@@ -1,7 +1,10 @@
 (ns early-vote-site.early-vote-site-detail.views
   (:require [re-frame.core :as re-frame]
+            [reagent.ratom :as r]
             [cljs-pikaday.reagent :as pikaday]
             [early-vote-site.utils :as utils]))
+
+(enable-console-print!)

 (def schedules-header
   [:thead
@@ -26,26 +29,31 @@
                               (re-frame/dispatch [:unassign-schedule (:assignment-id schedule)])
                               (re-frame/dispatch [:assign-schedule (:id schedule)]))}]]])

+(defn update-date
+  [key _ _ newvalue]
+  (re-frame/dispatch [key newvalue]))
+
 (defn schedule-form []
-  (let [start-date (re-frame/subscribe [:schedule-form/start-date])
-        end-date (re-frame/subscribe [:schedule-form/end-date])]
-    [:tr {:key "schedule-form"}
-     [:td [pikaday/date-selector {:class "form-control"
-                                  :date-atom start-date
-                                  :max-date-atom end-date
-                                  :pikaday-attrs
-                                  {:min-date (js/Date.)
-                                   :max-date @end-date
-                                   :on-select #(re-frame/dispatch [:schedule-form/start-date-selected %])}}]]
-     [:td [pikaday/date-selector {:class "form-control"
-                                  :date-atom end-date
-                                  :min-date-atom start-date
-                                  :pikaday-attrs
-                                  {:min-date (or @start-date (js/Date.))
-                                   :on-select #(re-frame/dispatch [:schedule-form/end-date-selected %])}}]]
-     [:td]
-     [:td]
-     [:td [:button.button {:on-click #(re-frame/dispatch [:schedule-form/save])} "save new schedule"]]]))
+  (let [start-date (r/atom (js/Date.))
+        end-date (r/atom nil)]
+    (add-watch start-date :schedule-form/start-date-selected update-date)
+    (add-watch end-date :schedule-form/end-date-selected update-date)
+    (fn []
+      [:tr {:key "schedule-form"}
+       [:td [pikaday/date-selector {:class "form-control"
+                                    :date-atom start-date
+                                    :max-date-atom end-date
+                                    :pikaday-attrs
+                                    {:min-date (js/Date.)
+                                     :max-date @end-date}}]]
+       [:td [pikaday/date-selector {:class "form-control"
+                                    :date-atom end-date
+                                    :min-date-atom start-date
+                                    :pikaday-attrs
+                                    {:min-date (or @start-date (js/Date.))}}]]
+       [:td]
+       [:td]
+       [:td [:button.button {:on-click #(re-frame/dispatch [:schedule-form/save])} "save new schedule"]]])))

 (defn schedules-list [selected-early-vote-site-id]
   (let [schedules @(re-frame/subscribe [:selected-early-vote-site-schedules])]


UI tweak (reviewed live)

UI tweak (reviewed live)

--- src/cljs/org/broadinstitute/firecloud_ui/common/table.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/common/table.cljs
@@ -354,6 +354,7 @@
           (when paginator-above [:div {:style {:paddingBottom (:paginator-space props)}} paginator])
           [:div {:style {:overflowX "auto"}}
            [:div {:style {:position "relative"
+                          :paddingBottom 10
                           :minWidth (reduce
                                       + (map :width (filter :showing? (:ordered-columns @state))))
                           :cursor (when (:dragging? @state) "col-resize")}}


always show action buttons when in edit-mode

--- iwaswhere-web/src/cljs/iwaswhere_web/ui/entry.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/ui/entry.cljs
@@ -114,7 +114,7 @@
                                   (update-in entry [:upvotes] op)]))]
         [:div {:on-mouse-enter #(reset! visible true)
                :on-mouse-leave hide-fn
-               :style          {:opacity (if @visible 1 0)}}
+               :style          {:opacity (if (or edit-mode? @visible) 1 0)}}
          [:span.fa.toggle
           {:on-click (upvote-fn inc)
            :class    (if (pos? upvotes) "fa-thumbs-up" "fa-thumbs-o-up")}]


allow ':mirrors' in options.

allow ':mirrors' in options.

--- src/leiningen/ancient/artifact/options.clj
+++ src/leiningen/ancient/artifact/options.clj
@@ -45,10 +45,29 @@
       (ancient/create-loaders)
       (wrap-loaders)))

+(defn- select-mirror
+  "Select a mirror for the given repository name/URL."
+  [mirrors name url]
+  (some
+    (fn [[match mirror]]
+      (when (or (and (string? match) (#{name url} match))
+                (and (instance? java.util.regex.Pattern match)
+                     (some #(re-matches match %) [name url])))
+        mirror))
+    mirrors))
+
+(defn select-mirrors
+  [repositories mirrors]
+  (->> (for [[name v] repositories
+             :let [url (if (string? v) v (:url v))
+                   mirror (select-mirror mirrors name url)]]
+         [name (or mirror v)])
+       (into {})))
+
 (defn options
   "Prepare the option map."
   ([] (options {}))
-  ([{:keys [repositories
+  ([{:keys [repositories mirrors
             dependencies? plugins? profiles?
             snapshots? qualified?
             check-clojure?]
@@ -57,8 +76,9 @@
           profiles? true
           qualified? false
           check-clojure? false}}]
-   {:repositories (prepare-repositories
-                    (or repositories ancient/default-repositories))
+   {:repositories (-> (or repositories ancient/default-repositories)
+                      (select-mirrors mirrors)
+                      (prepare-repositories))
     :snapshots? snapshots?
     :qualified? qualified?
     :check-clojure? check-clojure?


crawl function

crawl function

input list of domains
output handled with a function passed in as a parameter


Make conversion to js a tiny bit faster

Make conversion to js a tiny bit faster


No more pomegranate dependency

No more pomegranate dependency

--- jvm-runner/src/clojure/codewars/runner/clojure.clj
+++ jvm-runner/src/clojure/codewars/runner/clojure.clj
@@ -2,8 +2,33 @@
   (:require [codewars.runner :refer [run]]
             [codewars.util :as util]
             [codewars.clojure.test]
-            [cemerick.pomegranate :as pom])
-  (:import [codewars.java TempDir]))
+            [clojure.java.io :as io]
+            [dynapath.util :as dp])
+  (:import [codewars.java TempDir])
+  (:refer-clojure :exclude (add-classpath)))
+
+;; Extracted from cemerick.pomegranate
+(defn- classloader-hierarchy
+  "Returns a seq of classloaders, with the tip of the hierarchy first.
+   Uses the current thread context ClassLoader as the tip ClassLoader if one is not provided."
+  ([] (classloader-hierarchy (.. Thread currentThread getContextClassLoader)))
+  ([tip]
+    (->> tip
+      (iterate #(.getParent %))
+      (take-while boolean))))
+
+(defn- add-classpath
+  "A fixed version of the (deprecated) `add-classpath` in clojure.core."
+  ([jar-or-dir classloader]
+     (if-not (dp/add-classpath-url classloader (.toURL (.toURI (io/file jar-or-dir))))
+       (throw (IllegalStateException. (str classloader " is not a modifiable classloader")))))
+  ([jar-or-dir]
+    (let [classloaders (classloader-hierarchy)]
+      (if-let [cl (last (filter dp/addable-classpath? classloaders))]
+        (add-classpath jar-or-dir cl)
+        (throw (IllegalStateException. (str "Could not find a suitable classloader to modify from "
+                                            classloaders)))))))
+

 (defmethod run "clojure"
   [{:keys [:setup :solution :fixture] :as opts}]
@@ -12,7 +37,6 @@
         (util/write-code! "clojure" dir fixture)]
     (when setup (util/write-code! "clojure" dir setup))
     (util/write-code! "clojure" dir solution)
-    (pom/add-classpath dir)
-    fixture-ns
-    (require [fixture-ns])
+    (add-classpath dir)
+    (require fixture-ns)
     (codewars.clojure.test/run-tests fixture-ns)))


Removing inherit-multimethod

Removing inherit-multimethod

--- src/conexp/contrib/gui/editors/context_editor/util.clj
+++ src/conexp/contrib/gui/editors/context_editor/util.clj
@@ -150,13 +150,11 @@
          fltr (rho filter (fn [x] (when-not (nil? x) x))) ]
     (set (fltr (map (*comp view names) sel)))))

-(inherit-multimethod get-selected-attributes ::context-editor-widget
+(defn-typecheck get-selected-attributes ::context-editor-widget
   "Returns the set of selected attributes in the context-editor-widget.

   Parameters:
-    widget  _context-editor-widget")
-
-(defmethod get-selected-attributes ::context-editor-widget
+    widget  _context-editor-widget"
   [widget]
   (let [ table (get-table widget)
          view (get-column-index-permutator table)
@@ -356,14 +354,13 @@

-(inherit-multimethod get-ectx ::context-editor-widget
+(defn-typecheck get-ectx ::context-editor-widget
   "Returns the editable-context that is currently associated with the
    context-editor-widget.

   Parameters:
-    widget  _context-editor-widget")
-
-(defmethod get-ectx ::context-editor-widget
+    widget  _context-editor-widget"
+
   [widget] @(:e-ctx widget))

 (inherit-multimethod get-context ::context-editor-widget
@@ -376,15 +373,13 @@
 (defmethod get-context ::context-editor-widget
   [widget] (get-context @(:e-ctx widget)))

-(inherit-multimethod set-ectx ::context-editor-widget
+(defn-typecheck set-ectx ::context-editor-widget
   "Sets the editable-context that is currently associated with the
    context-editor-widget to the second parameter.

   Parameters:
     widget  _context-editor-widget
-    e-ctx   _new editable-context")
-
-(defmethod set-ectx ::context-editor-widget
+    e-ctx   _new editable-context"
   [widget e-ctx] (dosync-wait (ref-set (:e-ctx widget) e-ctx)))

@@ -530,14 +525,13 @@
       (deliver self e-ctx)
       e-ctx)))

-(inherit-multimethod add-widget ::editable-context
+(defn-typecheck add-widget ::editable-context
   "Adds a context-editor-widget to an editable context, and sets the
    editor windows table to represent the new context.
    Parameters:
      e-ctx   _editable-context
-     editor  _context-editor-widget")
-
-(defmethod add-widget ::editable-context
+     editor  _context-editor-widget"
+
   [e-ctx editor]
   (let [ ctx (get-context e-ctx)
          att-cols (:attr-cols e-ctx)
@@ -567,15 +561,12 @@
     (set-hook table "cell-value"
       (fn [r c s] (ectx-cell-value-hook e-ctx r c s)))))

-(inherit-multimethod set-context ::editable-context
+(defn-typecheck set-context ::editable-context
   "Sets the bound fca-context of an editable context object to ctx.

    Parameters:
     ectx   _editable-context object
-    ctx    _new context")
-
-(defmethod
-  set-context ::editable-context
+    ctx    _new context"
   [ectx ctx]
   (let [ new (make-editable-context ctx)
          widgets @(:widgets ectx) ]
@@ -592,16 +583,14 @@
 (declare-multimethod change-object-name)
 (declare-multimethod change-incidence-cross)

-(inherit-multimethod change-incidence-cross ::editable-context
+(defn-typecheck change-incidence-cross ::editable-context
  "Sets or unsets the cross in the incidence relation of the editable-context.

   Parameters:
      ectx       _editable-context
      obj        _object
      att        _attribute
-     cross      _true or false")
-
-(defmethod change-incidence-cross ::editable-context
+     cross      _true or false"
   [ectx obj att cross]
   (let [ ostr (if (= (type obj) String) obj
                 (@(:obj-rows ectx) obj))
@@ -622,7 +611,7 @@
                   row col (if cross "X" " ")))))))

-(inherit-multimethod change-attribute-name ::editable-context
+(defn-typecheck change-attribute-name ::editable-context
  "Changes the attributes name of given to requested, if requested is
   not taken by another attribute. In this case, -# with a unique # is
   appended to the requested name. Returns the new attribute name
@@ -630,9 +619,7 @@
   Parameters:
      ectx       _editable-context
      given      _current attribute name or column index
-     requested  _requested new attribute name")
-
-(defmethod change-attribute-name ::editable-context
+     requested  _requested new attribute name"
   [ectx given requested]
   (let [ att-cols @(:attr-cols ectx) ]
     (if (= (type given) String)
@@ -660,7 +647,7 @@
           new-name)))))

-(inherit-multimethod change-object-name ::editable-context
+(defn-typecheck change-object-name ::editable-context
  "Changes the object's name of given to requested, if requested is
   not taken by another object. In this case, -# with a unique # is
   appended to the requested name. Returns the new attribute name
@@ -668,9 +655,7 @@
   Parameters:
      ectx       _editable-context
      given      _current attribute name or column index
-     requested  _requested new attribute name")
-
-(defmethod change-object-name ::editable-context
+     requested  _requested new attribute name"
   [ectx given requested]
   (let [ obj-cols @(:obj-rows ectx) ]
     (if (= (type given) String)


Errepikatutako querya kendu

Errepikatutako querya kendu


Convert workspace component to use new defc macro.

--- frontend/src/uxbox/main/ui/workspace.cljs
+++ frontend/src/uxbox/main/ui/workspace.cljs
@@ -2,13 +2,11 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz>
-;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com>
+;; Copyright (c) 2015-2017 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2015-2017 Juan de la Cruz <delacruzgarciajuan@gmail.com>

 (ns uxbox.main.ui.workspace
-  (:require [sablono.core :as html :refer-macros [html]]
-            [rum.core :as rum]
-            [beicon.core :as rx]
+  (:require [beicon.core :as rx]
             [uxbox.main.constants :as c]
             [potok.core :as ptk]
             [uxbox.store :as st]
@@ -16,10 +14,6 @@
             [uxbox.main.data.pages :as udp]
             [uxbox.main.data.history :as udh]
             [uxbox.main.data.undo :as udu]
-            [uxbox.util.dom :as dom]
-            [uxbox.util.geom.point :as gpt]
-            [uxbox.util.data :refer (classnames)]
-            [uxbox.util.mixins :as mx :include-macros true]
             [uxbox.main.ui.messages :as uum]
             [uxbox.main.ui.confirm]
             [uxbox.main.ui.workspace.images]
@@ -33,7 +27,11 @@
             [uxbox.main.ui.workspace.sidebar.history :refer (history-dialog)]
             [uxbox.main.ui.workspace.sidebar :refer (left-sidebar right-sidebar)]
             [uxbox.main.ui.workspace.colorpalette :refer (colorpalette)]
-            [uxbox.main.ui.workspace.canvas :refer (viewport)]))
+            [uxbox.main.ui.workspace.canvas :refer (viewport)]
+            [uxbox.util.dom :as dom]
+            [uxbox.util.geom.point :as gpt]
+            [uxbox.util.data :refer (classnames)]
+            [uxbox.util.mixins :as mx :include-macros true]))

 ;; --- Workspace

@@ -99,7 +97,15 @@
         (st/emit! (dw/decrease-zoom)))
       (scroll/scroll-to-point dom mouse-point scroll-position))))

-(defn- workspace-render
+(mx/defcs workspace
+  {:did-remount workspace-did-remount
+   :will-mount workspace-will-mount
+   :will-unmount workspace-will-unmount
+   :did-mount workspace-did-mount
+   :mixins [mx/static
+            mx/reactive
+            shortcuts-mixin
+            (mx/local)]}
   [own]
   (let [{:keys [flags zoom page] :as workspace} (mx/react wb/workspace-ref)
         left-sidebar? (not (empty? (keep flags [:layers :sitemap
@@ -110,47 +116,34 @@
         classes (classnames
                  :no-tool-bar-right (not right-sidebar?)
                  :no-tool-bar-left (not left-sidebar?)
-                 :scrolling (:scrolling @local false))]
-    (html
-     [:div
-      (header)
-      (colorpalette)
-      (uum/messages)
+                 :scrolling (:viewport-positionig workspace))]
+    [:div
+     (header)
+     (colorpalette)
+     (uum/messages)

-      [:main.main-content
+     [:main.main-content

-       [:section.workspace-content
-        {:class classes
-         :on-scroll on-scroll
-         :on-wheel (partial on-wheel own)}
+      [:section.workspace-content
+       {:class classes
+        :on-scroll on-scroll
+        :on-wheel (partial on-wheel own)}

-        (history-dialog page)
+       (history-dialog page)

-        ;; Rules
-        (horizontal-rule zoom)
-        (vertical-rule zoom)
+       ;; Rules
+       (horizontal-rule zoom)
+       (vertical-rule zoom)

-        ;; Canvas
-        [:section.workspace-canvas
-         {:ref "workspace-canvas"}
-         (viewport)]]
+       ;; Canvas
+       [:section.workspace-canvas
+        {:id "workspace-canvas"
+         :ref "workspace-canvas"}
+        (viewport)]]

-       ;; Aside
-       (when left-sidebar?
-         (left-sidebar))
-       (when right-sidebar?
-         (right-sidebar))]])))
-
-(def workspace
-  (mx/component
-   {:render workspace-render
-    :did-remount workspace-did-remount
-    :will-mount workspace-will-mount
-    :will-unmount workspace-will-unmount
-    :did-mount workspace-did-mount
-    :name "workspace"
-    :mixins [mx/static
-             mx/reactive
-             shortcuts-mixin
-             (mx/local)]}))
+      ;; Aside
+      (when left-sidebar?
+        (left-sidebar))
+      (when right-sidebar?
+        (right-sidebar))]]))


Fix typo

Fix typo

--- frontend/test/warehouse/selenium/test.clj
+++ frontend/test/warehouse/selenium/test.clj
@@ -63,7 +63,7 @@
   (refresh)

   ; guard: there is zero components
-  (is (empty? (elements "//li[@class='ccomponent']")))
+  (is (empty? (elements "//li[@class='component']")))

   (upload-file (fixture-path "export.json"))


Add clean-annotations docstring

Add clean-annotations docstring

--- test/caesium/binding_test.clj
+++ test/caesium/binding_test.clj
@@ -64,6 +64,7 @@
 (declare check-method check-const-method)

 (defn ^:private clean-annotations
+  "Given some annotation instances, return the set of their types."
   [annotations]
   (set (map #(.annotationType ^Annotation %) annotations)))


test that custom encoders can remove and replace defaults

--- test/cheshire/test/custom.clj
+++ test/cheshire/test/custom.clj
@@ -117,15 +117,24 @@
     (/ (double (- (System/nanoTime) start)) 1000000.0)))

 (deftest test-add-remove-encoder
-  (do
-    (json/remove-encoder java.net.URL)
-    (json/add-encoder java.net.URL json/encode-str)
-    (is (= "\"http://foo.com\""
-           (json/generate-string (java.net.URL. "http://foo.com")))))
-  (do
-    (json/remove-encoder java.net.URL)
-    (is (thrown? IllegalArgumentException
-                 (json/generate-string (java.net.URL. "http://foo.com"))))))
+  (json/remove-encoder java.net.URL)
+  (json/add-encoder java.net.URL json/encode-str)
+  (is (= "\"http://foo.com\""
+         (json/generate-string (java.net.URL. "http://foo.com"))))
+  (json/remove-encoder java.net.URL)
+  (is (thrown? IllegalArgumentException
+               (json/generate-string (java.net.URL. "http://foo.com")))))
+
+;; Test that default encoders can be removed if so desired.
+(deftest test-shadowing-default-encoder
+  (json/remove-encoder java.util.Date)
+  (json/add-encoder java.util.Date
+                    (fn [d jg] (json/encode-str "foo" jg)))
+  (is (= "\"foo\"" (json/generate-string (java.util.Date.))))
+  (json/remove-encoder java.util.Date)
+  (json/add-encoder java.util.Date json/encode-date)
+  (is (json/generate-string (java.util.Date.))
+      "shouldn't throw an exception after adding back the default."))

 (deftest test-namespaced-keywords
   (is (= "{\"foo\":\"user/bar\"}"


Fix logic in rule removing older unique identity facts

--- test/clj/libx/perf_tuple.cljc
+++ test/clj/libx/perf_tuple.cljc
@@ -82,7 +82,7 @@

 (def-tuple-rule remove-older-unique-identity-facts
   {:super true :salience 100}
-  [[?e :unique-identity]]
+  [[?e :unique-identity _ ?t1]]
   [[?e ?a _ ?t1]]
   [?fact2 <- [?e ?a _ ?t2]]
   [:test (> ?t1 ?t2)]
@@ -125,7 +125,7 @@
   (cr/mk-session 'libx.perf-tuple
    :fact-type-fn (fn [fact] (:a fact))
    :ancestors-fn ancestors-fn
-   :activation-group-fn activation-group-fn
+   :activation-group-fn (fn [x] #_(println "Activation group fn" x) (activation-group-fn x))
    :activation-group-sort-fn activation-group-sort-fn))

 (defn n-facts-session [n]
@@ -155,14 +155,6 @@
 ;; report
 ;; cleanup

-;;TODO. Remove or move to test
-;(activation-group-fn {:props {:salience 100
-;                              :group :cleanup)
-;
-;(activation-group-sort-fn {:group :schema :salience -100}
-;                          {:group :cleanup :salience 100})
-                          ;{:group "cleanup"})
-

 ;; Timings - all our stuff
 ;; 100,000 facts


Added a test for the new destroy-records model function.

--- test/clj_record/core_test.clj
+++ test/clj_record/core_test.clj
@@ -62,6 +62,13 @@
     (manufacturer/destroy-record {:id (humedai :id)})
     (is (empty? (manufacturer/find-records {:id (humedai :id)})))))

+(defdbtest destroy-records-destroys-by-prototype
+  (let [name-map { :name "Humedai Motors" }
+        humedai1 (manufacturer/create (valid-manufacturer-with name-map))
+        humedai2 (manufacturer/create (valid-manufacturer-with name-map))]
+    (manufacturer/destroy-records name-map)
+    (is (empty? (manufacturer/find-records name-map)))))
+
 (defdbtest update-uses-id-to-update-other-given-attributes-leaving-unspecified-attributes-untouched
   (let [humedai (manufacturer/create (valid-manufacturer-with {:name "Humedai Motors" :grade 90}))
         id (humedai :id)]


add name test for keywords

add name test for keywords

--- test/cljs/cljs/core_test.cljs
+++ test/cljs/cljs/core_test.cljs
@@ -213,6 +213,7 @@
   ;(assert (= "foo/bar" (namespace :foo/bar/baz)))
   (assert (nil? (namespace '/)))
   (assert (= "/" (name '/)))
+  (assert (= "keyword" (name :keyword)))
   ;;TODO: These next two tests need Clojure 1.5
   ;(assert (= "foo" (namespace 'foo//)))
   ;(assert (= "/" (name 'foo//)))


further refactoring to disentangle IDurable from the underlying atom

--- src/duratom/core.clj
+++ src/duratom/core.clj
@@ -24,8 +24,7 @@
   (write_out [_]
     (storage/commit storage-backend))
   (read_in [this]
-    ;; reset the underlying atom directly to avoid writing exactly what was read in
-    (reset! underlying-atom (storage/snapshot storage-backend)))
+    (storage/snapshot storage-backend))
   (destroy [_]
     (storage/cleanup storage-backend)
     (release true)) ;; the only place where this is called with an argument
@@ -104,11 +103,12 @@
               (nil? lock))
           "The <lock> provided is neither a valid implementation of `java.util.concurrent.locks.Lock`, nor nil!")
   (let [raw-atom (atom nil)
-        backend (make-backend (agent raw-atom))
-        duratom (Duratom. backend raw-atom lock (ut/releaser))
+        duratom (Duratom. (make-backend (agent raw-atom)) raw-atom lock (ut/releaser))
         storage-init (read_in duratom)]
-    (if (some? storage-init) ;; found stuff
-      duratom
+    (if (some? storage-init) ;; found stuff - sync it
+      (do ;; reset the raw atom directly to avoid writing exactly what was read in
+        (reset! raw-atom storage-init)
+        duratom)
       (cond-> duratom
               (some? init) (doto (reset! init)))))) ;; empty storage means we start off with <initial-value>


CMR-1285: Updates cmr.spatial.math/float->double to work under Java 8

--- spatial-lib/src/cmr/spatial/math.clj
+++ spatial-lib/src/cmr/spatial/math.clj
@@ -58,7 +58,7 @@
   (float->double (float 0.1)) => 0.1
   See http://programmingjungle.blogspot.com/2013/03/float-to-double-conversion-in-java.html"
   ^double [v]
-  (.doubleValue (sun.misc.FloatingDecimal. ^float v)))
+  (.doubleValue (Double. (str v))))

 (defn- shift-float
   "Shifts the mantissa of the float by 1 in the positive of negative direction to increase the float


Update only through master branch

Update only through master branch

--- src-cljs/cljs_workspace/om_test.cljs
+++ src-cljs/cljs_workspace/om_test.cljs
@@ -10,9 +10,10 @@
             [om-sync.core :refer [om-sync]]
             [om-sync.util :refer [tx-tag edn-xhr]]
             [cljs-workspace.morph :as morphic :refer [set-fill toggle-halo find-morph-path]]
-            [cljs-workspace.history :as history :refer [app-state init-history]]
-            [cljs-workspace.repl :as repl]
-            [cljs-workspace.branch-merge :as branch-merge])
+            [cljs-workspace.history :as history :refer [app-state init-history current-branch]]
+            [cljs-workspace.branch-merge :as branch-merge]
+            [cljs-workspace.branch-vis :refer [is-master]]
+            [cljs-workspace.repl :as repl])
   (:import [goog.events EventType]))

 (enable-console-print!)
@@ -88,6 +89,7 @@
 ;   {:target (. js/document (getElementById "inspector"))})

 (defn send-update [state]
+  (prn "Sending update!")
   (.send @socket (pr-str (select-keys (state :tx-data) [:new-value :path]))))

 (let [sub-chan (chan)]
@@ -130,8 +132,9 @@
              conn (js/WebSocket. (str "ws://" host ":" port "/ws"))]
             (set! (.-onmessage conn) (fn [e]
               (when-let [state (read-string (.-data e))]
-                (.log js/console state)
-                (reset! app-state state))))
+                (.log js/console e)
+                (history/save-to-master state)
+                (when (is-master @current-branch) (reset! app-state state)))))
             (reset! socket conn)) ; set the socket, so that it can be used for sending things
         (when-not (nil? res) (reset! app-state res))
         (om/root app-view app-state
@@ -140,7 +143,7 @@
             :tx-listen
             (fn [tx-data root-cursor]
                 (history/save-state (:new-state tx-data)) ; to enable the timeline
-                (put! tx-chan [tx-data root-cursor]))}))}))
+                (when (is-master @current-branch) (put! tx-chan [tx-data root-cursor])))}))}))

 ; (om/root
 ;   (fn [app owner]


WIP Add transformation opts specs

WIP Add transformation opts specs

--- backend/specs/akvo/lumen/specs/transformation.clj
+++ backend/specs/akvo/lumen/specs/transformation.clj
@@ -56,9 +56,62 @@

 (s/def ::db.dsv/columns (s/coll-of ::db.dsv/column :kind vector? :distinct true))

-
-
 (s/def ::next-dataset-version (s/keys :req-un [::db.dsv/id ::db.dsv/dataset-id
                                                ::db.dsv/job-execution-id ::db.dsv/table-name
                                                ::db.dsv/imported-table-name ::db.dsv/version
                                                ::db.dsv/transformations ::db.dsv/columns]))
+
+(s/def ::type #{:transformation :undo})
+
+
+(defmulti command-spec ::type)
+
+(defmethod command-spec :undo [_]
+  (s/keys :req [::type]))
+
+(defmethod command-spec :transformation [_]
+  (s/keys :req [::type]))
+
+(s/def ::command (s/multi-spec command-spec ::type))
+
+(lumen.s/sample ::command)
+
+(create-ns  'akvo.lumen.specs.transformation.engine)
+(alias 'transformation.engine 'akvo.lumen.specs.transformation.engine)
+
+(s/def ::transformation.engine/onError #{"leave-empty" "fail" "delete-row" "default-value"})
+
+(s/def ::transformation.engine/op #{:core/change-datatype
+				    :core/combine
+				    :core/delete-column
+				    :core/derive
+				    :core/filter-column
+				    :core/generate-geopoints
+				    :core/merge-datasets
+				    :core/remove-sort
+				    :core/rename-column
+				    :core/reverse-geocode
+				    :core/sort-column
+				    :core/to-lowercase
+				    :core/to-titlecase
+				    :core/to-uppercase
+				    :core/trim
+				    :core/trim-doublespace})
+
+(defmulti op-spec ::transformation.engine/op)
+
+(s/def ::transformation.engine/op-spec
+  (s/multi-spec op-spec ::transformation.engine/op))
+
+(create-ns  'akvo.lumen.specs.transformation.delete-column)
+(alias 'transformation.delete-column 'akvo.lumen.specs.transformation.delete-column)
+
+(s/def ::transformation.delete-column/args
+  (s/keys :req-un [::db.dsv.column/columnName]))
+
+(defmethod op-spec :core/delete-column  [_]
+  (s/keys
+   :req-un [::transformation.delete-column/args
+	    ::transformation.engine/onError]))
+
+(lumen.s/sample ::transformation.engine/op-spec 10)


Sort timestamps from collection of tariff profiles.

--- src/clj/kixi/hecuba/data/measurements/calculations.clj
+++ src/clj/kixi/hecuba/data/measurements/calculations.clj
@@ -253,7 +253,9 @@
   [store entity_id]
   (db/with-session [session (:hecuba-session store)]
     (let [profiles (profiles/get-profiles entity_id session)]
-      (map #(select-keys % [:timestamp :profile_data]) profiles))))
+      (->> profiles
+           (map #(select-keys % [:timestamp :profile_data]))
+           (sort-by :timestamp)))))

 (defn tariff-ranges
   "Filters timestamps from tariffs, and creates ranges of datetimes


Adapt use-hex-colors snippet for use with p5

--- src/cljc/quil/snippets/color/creating_and_reading.cljc
+++ src/cljc/quil/snippets/color/creating_and_reading.cljc
@@ -274,18 +274,34 @@
       (q/fill (q/lerp-color c1 c2 (/ i 5)))
       (q/rect (* i 70) (* i 70) 100 100))))

-; snippet to make sure that using hex colors doesn't throw error.
-(defsnippet use-hex-colors
-  ; specify no function so it doesn't get added as snippet in API.
-  []
-  {}
-
-  (q/lerp-color 0xFF00FF00 0xFF0000FF 0.5)
-  (q/hue 0xFF112233)
-  (q/saturation 0xFF112233)
-  (q/brightness 0xFF112233)
-  (q/red 0xFF112233)
-  (q/green 0xFF112233)
-  (q/blue 0xFF112233)
-  (q/blend-color 0xFF00FF00 0xFFFF0000 :blend)
-  (q/background 0xFF112233))
+#?(:clj
+   ; snippet to make sure that using hex colors doesn't throw error.
+   (defsnippet use-hex-colors
+     ; specify no function so it doesn't get added as snippet in API.
+     []
+     {}
+
+     (q/lerp-color 0xFF00FF00 0xFF0000FF 0.5)
+     (q/hue 0xFF112233)
+     (q/saturation 0xFF112233)
+     (q/brightness 0xFF112233)
+     (q/red 0xFF112233)
+     (q/green 0xFF112233)
+     (q/blue 0xFF112233)
+     (q/blend-color 0xFF00FF00 0xFFFF0000 :blend)
+     (q/background 0xFF112233)))
+
+#?(:cljs
+   ; snippet to make sure that using hex colors doesn't throw error.
+   (defsnippet use-hex-colors
+     ; specify no function so it doesn't get added as snippet in API.
+     []
+     {}
+
+     (q/hue "0xFF112233")
+     (q/saturation "0xFF112233")
+     (q/brightness "0xFF112233")
+     (q/red "0xFF112233")
+     (q/green "0xFF112233")
+     (q/blue "0xFF112233")
+     (q/background "0xFF112233")))


Remove bug

Remove bug

--- src/cljs/wombats_web_client/components/cards/game.cljs
+++ src/cljs/wombats_web_client/components/cards/game.cljs
@@ -45,7 +45,7 @@
   (let [game-state (get-game-state-str is-full is-playing)]

     [:div.arena-preview
-     (when false ;;game-state
+     (when game-state
        [:div.game-state-wrapper
         [:div.state-overlay]
         [:div.game-state game-state]])
@@ -53,7 +53,7 @@
      (when is-open
        [:div.countdown "Starts in "
         [countdown-timer start-time]])
-     (when true ;;is-joinable
+     (when is-joinable
        [:button {:class (str "join-button"
                              (when is-private " private"))
                  :onClick (open-join-game-modal-fn game-id)}