Implement get-scene-from-panel with protocols

and not with a closure. This eleminiates possible memory leaks.

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

--- src/conexp/contrib/draw/lattices.clj
+++ src/conexp/contrib/draw/lattices.clj
@@ -31,71 +31,72 @@

 ;;; Lattice Editor

-(let [scenes (ref {})]
+(defprotocol WithScene
+  "Storing scene objects."
+  (^Gscene getScene [this]
+    "Returns the associated scene."))

-  (defn ^JPanel make-lattice-editor
-    "Creates a lattice editor with initial layout."
-    [frame layout]
-    (let [layout       (scale-layout [0 0] [100 100] layout),
+(defn ^JPanel make-lattice-editor
+  "Creates a lattice editor with initial layout."
+  [frame layout]
+  (let [layout       (scale-layout [0 0] [100 100] layout),

-          main-panel   (JPanel. (BorderLayout.)),
+        scn          (draw-on-scene layout),
+        canvas       (scene-canvas scn),
+        main-panel   (proxy [JPanel conexp.contrib.draw.lattices.WithScene] [(BorderLayout.)]
+                       (getScene []
+                         scn)),

-          scn          (draw-on-scene layout),
-          canvas       (scene-canvas scn),
+        canvas-panel (JPanel. (BorderLayout.)),
+        hscrollbar   (JScrollBar. JScrollBar/HORIZONTAL),
+        vscrollbar   (JScrollBar. JScrollBar/VERTICAL),

-          canvas-panel (JPanel. (BorderLayout.)),
-          hscrollbar   (JScrollBar. JScrollBar/HORIZONTAL),
-          vscrollbar   (JScrollBar. JScrollBar/VERTICAL),
+        buttons      (JPanel.),
+        box-layout   (BoxLayout. buttons BoxLayout/Y_AXIS)]

-          buttons      (JPanel.),
-          box-layout   (BoxLayout. buttons BoxLayout/Y_AXIS)]
+    ;; buttons
+    (.setLayout buttons box-layout)
+    (.setPreferredSize buttons (Dimension. *toolbar-width* 600))
+    (with-layout-modifiers frame scn buttons
+      toggle-zoom-move
+      change-parameters,
+      (control-choice "Freese" freese,
+                      "Force"  improve-layout-by-force),
+      snapshot-saver,
+      export-as-file)

-      ;; save scene
-      (dosync (alter scenes assoc main-panel scn))
+    ;; drawing area
+    (doto canvas-panel
+      (.add canvas BorderLayout/CENTER)
+      (.add hscrollbar BorderLayout/SOUTH)
+      (.add vscrollbar BorderLayout/EAST))
+    (add-scrollbars scn hscrollbar vscrollbar)

-      ;; buttons
-      (.setLayout buttons box-layout)
-      (.setPreferredSize buttons (Dimension. *toolbar-width* 600))
-      (with-layout-modifiers frame scn buttons
-        toggle-zoom-move
-        change-parameters,
-        (control-choice "Freese" freese,
-                        "Force"  improve-layout-by-force),
-        snapshot-saver,
-        export-as-file)
+    ;; main panel
+    (doto main-panel
+      (.add canvas-panel BorderLayout/CENTER)
+      (.add (JScrollPane. buttons JScrollPane/VERTICAL_SCROLLBAR_ALWAYS
+                          JScrollPane/HORIZONTAL_SCROLLBAR_NEVER)
+            BorderLayout/WEST)
+      (.setMinimumSize (Dimension. 0 0)))

-      ;; drawing area
-      (doto canvas-panel
-        (.add canvas BorderLayout/CENTER)
-        (.add hscrollbar BorderLayout/SOUTH)
-        (.add vscrollbar BorderLayout/EAST))
-      (add-scrollbars scn hscrollbar vscrollbar)
+    ;; return main panel
+    main-panel))

-      ;; main panel
-      (doto main-panel
-        (.add canvas-panel BorderLayout/CENTER)
-        (.add (JScrollPane. buttons JScrollPane/VERTICAL_SCROLLBAR_ALWAYS
-                            JScrollPane/HORIZONTAL_SCROLLBAR_NEVER)
-              BorderLayout/WEST)
-        (.setMinimumSize (Dimension. 0 0)))
+(defn get-scene-from-panel
+  "If the given panel contains a lattice editor, returns the
+  corresponding scene, nil otherwise."
+  [^JPanel panel]
+  (when (instance? conexp.contrib.draw.lattices.WithScene panel)
+    (.getScene panel)))

-      ;; return main panel
-      main-panel))
+(defn get-layout-from-panel
+  "If the given panel contains a lattice editor, return the
+  corresponding layout and nil otherwise."
+  [panel]
+  (when-let [scn (get-scene-from-panel panel)]
+    (get-layout-from-scene scn)))

-  (defn get-scene-from-panel
-    "If the given panel contains a lattice editor, returns the
-    corresponding scene, nil otherwise."
-    [panel]
-    (get @scenes panel nil))
-
-  (defn get-layout-from-panel
-    "If the given panel contains a lattice editor, return the
-    corresponding layout and nil otherwise."
-    [panel]
-    (when-let [scn (get-scene-from-panel panel)]
-      (get-layout-from-scene scn)))
-
-  nil)

 ;;; Drawing Routine for the REPL


Remove duplicated code

Remove duplicated code

--- src/day8/re_frame_10x/view/code.cljs
+++ src/day8/re_frame_10x/view/code.cljs
@@ -30,64 +30,8 @@
 ;; Listing: a block of traced Clojure code, e.g. an event handler function

 (defn render []
-  (let [code-traces      @(rf/subscribe [:code/current-code])
-        highlighted-form @(rf/subscribe [:code/highlighted-form])]
-    [rc/v-box
-     :size "1 1 auto"
-     :class "code-panel"
-     :children
-     [[:h1 "Code"]
-      [:pre "Hover " (pr-str highlighted-form) "\n"]
-      (doall
-        (for [code-execution code-traces]
-          ^{:key (:id code-execution)}
-          [rc/v-box
-           :size "1 1 auto"
-           :gap "5px"
-           :children
-           (let [form       (:form code-execution)
-                 form-str   (zp/zprint-str form)
-                 search-str highlighted-form
-                 start      (str/index-of form-str search-str)
-                 length     (if (some? search-str)
-                              (count (pr-str search-str))
-                              0)
-                 before     (subs form-str 0 start)
-                 end-index  (+ start length)
-                 highlight  (subs form-str start end-index)
-                 after      (subs form-str end-index)
-                 ]
-             [[:h2 (:title code-execution)]
-              [:pre.code-listing
-               (list ^{:key "before"} before
-                     ^{:key "hl"} [:span.code-listing--highlighted highlight]
-                     ^{:key "after"} after)]
-              [:br]
-              [rc/v-box
-               :size "1 1 auto"
-               :style {:overflow-y "scroll"}
-               :children
-               (doall
-                 (->> (:code code-execution)
-                      ;; Remove traced function values, these are usually not very interesting in and of themselves.
-                      (remove (fn [line] (fn? (:result line))))
-                      (map-indexed
-                        (fn [i line]
-                          (list
-                            ;; See https://github.com/reagent-project/reagent/issues/350 for why we use random-uuid here
-                            ^{:key (random-uuid)}
-                            [rc/v-box
-                             :class "code-fragment"
-                             :style {:margin-left (str (* 50 (dec (:indent-level line))) "px")}
-                             :attr {:on-mouse-enter #(do (println "Enter" (:form line))
-                                                         (rf/dispatch [:code/hover-form (:form line)])
-                                                         true)
-                                    :on-mouse-leave #(do (println "Leave" (:form line))
-                                                         (rf/dispatch [:code/exit-hover-form (:form line)])
-                                                         true)}
-                             :children [[:pre (zp/zprint-str (:form line))]
-                                        ;; TODO: disable history expansion, or at least storing of it in ls.
-                                        [components/simple-render (:result line) [(:id code-execution) i]]]]
-                            ^{:key (random-uuid)}
-                            [rc/gap-f :size "5px"]))
-                        )))]])]))]]))
+  [rc/v-box
+   :size "1 1 auto"
+   :class "code-panel"
+   :children
+   [[:h1 "Code moved to Events"]]])


Call start with timestamp parameter for Safari compatibility

--- src/alder/node.cljs
+++ src/alder/node.cljs
@@ -37,8 +37,8 @@
                     ((:constructor node-type) context))]
     (assign-default-node-inputs node)
     (when (.-start (:audio-node node))
-      (debug "starting audio node" (:audio-node node))
-      (.start (:audio-node node)))
+      (debug "starting audio node" (:audio-node node) (.-start (:audio-node node)))
+      (.start (:audio-node node) 0))
     node))

 (defn node-move-to [node position]


tf-score is now way faster, just returns one. queries SUPER SPEED

--- src/help_me_im_dumb/query_engine.clj
+++ src/help_me_im_dumb/query_engine.clj
@@ -30,9 +30,7 @@
 (defn tf-score
   "given 1 doc and 1 term find term freq"
   [term docid]
-  (count
-    (re-seq(re-pattern term)
-            (get (index/docid->doc docid) :title))))
+  1)

 (defn tfidf-scores
   [docids term]


incredible fix

incredible fix

--- src/bossig/kaos.clj
+++ src/bossig/kaos.clj
@@ -17,6 +17,8 @@

 (def width 1440)
 (def height 980)
+(def width 1920)
+(def height 1200)
 (def server (atom nil))
 (def tr (seq->stream (cycle-between 1 1 16 0.1 0.1)))

@@ -30,7 +32,7 @@

 ;(remove-event-handler ::keyboard-handler)

-(println @bd)
+;;(println @bd)

@@ -39,7 +41,7 @@

-(defn update2 [state]
+(defn update [state]
     {
    :beat @bbeat
    :bd @bd
@@ -71,7 +73,7 @@
 (defn draw [state]
   (q/background [ 1 128 0]

-                (bassdrum [state]))
+  (bassdrum [state]))
   (.sendScreen @server)
   )


Fix all-closed-sets-in-family

Fix all-closed-sets-in-family

This function computed too much in the beginning so that
computing the lazy sequence did more work then necessary.

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

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -113,17 +113,18 @@
   ([predicate base clop]
      (all-closed-sets-in-family predicate base clop #{}))
   ([predicate base clop initial]
-     (let [base (if (set? base) (improve-basic-order base clop) base),
-           initial (clop initial),
-           start   (if (predicate initial)
-                     initial
-                     (next-closed-set-in-family predicate base clop initial)),
-           runner  (fn runner [X]
-                     (lazy-seq
-                      (if (nil? X)
-                        nil
-                        (cons X (runner (next-closed-set-in-family predicate base clop X))))))]
-         (runner initial))))
+     (lazy-seq
+      (let [base    (if (set? base) (improve-basic-order base clop) base),
+            initial (clop initial),
+            start   (if (predicate initial)
+                      initial
+                      (next-closed-set-in-family predicate base clop initial)),
+            runner  (fn runner [X]
+                      (lazy-seq
+                       (if (nil? X)
+                         nil
+                         (cons X (runner (next-closed-set-in-family predicate base clop X))))))]
+        (runner start)))))

 (defn next-closed-set
   "Computes next closed set of the closure operator clop after A with


Made «ask» more sophisticated

Made «ask» more sophisticated

It now can take an arbitrary number of predicates.

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

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -297,20 +297,28 @@

 (defn ask
   "Performs simple quering. prompt is printed first and then the user
-  is asked for an answer (via read). If this answer does not satisfy
-  pred, fail-message is printed and the user is asked again, until the
-  given answer fulfills pred."
-  [prompt read pred fail-message]
-  (let [sentinel (Object.),
-        read-fn  #(try (read) (catch Throwable _ sentinel))]
+  is asked for an answer (via read). The other arguments are
+  predicates with corresponding error messages. If a given answer does
+  not satisfy some predicate pred, it's associated error message is
+  printed and the user is asked again, until the given answer fulfills
+  all given predicates."
+  [prompt read & preds-and-fail-messages]
+  (when-not (even? (count preds-and-fail-messages))
+    (illegal-argument "Every predicate needs to have a corresponding error message."))
+  (let [predicates (partition 2 preds-and-fail-messages),
+        sentinel   (Object.),
+        read-fn    #(try (read) (catch Throwable _ sentinel))]
     (do
       (print prompt)
       (flush)
       (loop [answer (read-fn)]
-        (if (or (identical? answer sentinel)
-                (not (pred answer)))
+        (if-let [fail (if (identical? answer sentinel)
+                        "An error occured while reading.\n",
+                        (first-non-nil (map #(when-not ((first %) answer)
+                                               (second %))
+                                            predicates)))]
           (do
-            (print fail-message)
+            (print fail)
             (flush)
             (recur (read-fn)))
           answer)))))


Some code cleanup

Some code cleanup

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

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -7,8 +7,6 @@
 ;; You must not remove this notice, or any other, from this software.

 (in-ns 'conexp.base)
-
-(use 'clojure.test)

 ;;; def macros, inspired and partially copied from clojure.contrib.def, 1.3.0-SNAPSHOT

@@ -103,11 +101,13 @@
   ([] (test-conexp false))
   ([with-contrib?]
      (if with-contrib?
-       (do (require 'conexp.tests
+       (do (require 'clojure.test
+                    'conexp.tests
                     'conexp.contrib.tests)
            (clojure.test/run-tests 'conexp.tests
                                    'conexp.contrib.tests))
-       (do (require 'conexp.tests)
+       (do (require 'clojure.test
+                    'conexp.tests)
            (clojure.test/run-tests 'conexp.tests)))))

 (defmacro tests-to-run


refiltering sma users

refiltering sma users

--- src/mljalfa/znet/learning/snmptn.clj
+++ src/mljalfa/znet/learning/snmptn.clj
@@ -127,14 +127,13 @@
   [user-data]
   (let [datum (assoc (:datum user-data) -1 1)
         pompom (apply max-key val datum)]
-    (if (#{43 44 45} (first pompom)) (> (datum 43 0) 10) false)))
+    (if (cg-smas (first pompom)) (> (reduce + (vals datum)) 50) false)))

 (defn count-lulus-snmptn
   [pre-source post-source]
   (let [pre-data (open-file pre-source)
         post-data (sequence
-                    (comp (filter #(<= (reduce + (vals (:datum %))) 5))
-                          (map :memberid))
+                    (map :memberid)
                     (open-file post-source))
         kelas12 (->> (sequence
                        (comp (filter kelas12?)
@@ -147,14 +146,13 @@
   [user-data]
   (let [datum (assoc (:datum user-data) -1 1)
         pompom (apply max-key val datum)]
-    (if (#{41 42 43 44 45} (first pompom)) (> (datum 45 0) 10) false)))
+    (if (cg-smas (first pompom)) (> (datum 45 0) 1) false)))

 (defn count-lulus-sbmptn
   [pre-source post-source]
   (let [pre-data (open-file pre-source)
         post-data (sequence
-                    (comp (filter #(<= (reduce + (vals (:datum %))) 5))
-                          (map :memberid))
+                    (map :memberid)
                     (open-file post-source))
         bersbmptn (->> (sequence
                          (comp (filter bersbmptn?)
@@ -163,7 +161,47 @@
                        set)]
     [(count bersbmptn) (->> (keep bersbmptn post-data) count)]))

-
+(defn process-logs
+  [source-file target-file]
+  (let [raw (open-file source-file)
+        get-cg (fn [x] (->> (ckey "content" x)
+                            (cc/get-json cdb)
+                            :cg-id))
+        contents (->> (vals raw)
+                      (mapcat keys)
+                      distinct)
+        cc->cg (zipmap contents (pmap get-cg contents))
+        acum-cg (fn [x] (->> (map #(hash-map (cc->cg (key %)) (val %)) x)
+                             (reduce #(merge-with + %1 %2) {})))]
+    (->> (mapv #(hash-map :memberid (key %)
+                          :datum (acum-cg (val %))) raw)
+         (spit (fdir target-file)))))
+
+(defn process-logs-to-parents
+  [source-file target-file]
+  (let [raw (open-file source-file)
+        get-cg (fn [x] (->> (ckey "content-group" x)
+                            (cc/get-json cdb)
+                            :parents
+                            (sort-by :level >)
+                            second :id))
+        cgs (->> (map :datum raw)
+                 (mapcat keys)
+                 distinct)
+        cg->parent (zipmap cgs (pmap get-cg cgs))
+        acum-parent (fn [x] (->> (map #(hash-map (cg->parent (key %)) (val %)) x)
+                                 (reduce #(merge-with + %1 %2) {})))]
+    (->> (mapv #(hash-map :memberid (:memberid %)
+                          :datum (acum-parent (:datum %))) raw)
+         (spit (fdir target-file)))))
+
+(defn top-parent-clustering
+  [source-file]
+  (let [raw (open-file source-file)
+        not-empty-data (let [tmp (remove #(empty? (:datum %)) raw)]
+                         (println tmp) tmp)]
+    (->>
+         ())))

 (def name-smas
   '({:canonical-name "pelajaran-sma-kelas-10", :id 41}


Fix fast ack-message version.

Fix fast ack-message version.

--- src/onyx/messaging/acking_daemon.clj
+++ src/onyx/messaging/acking_daemon.clj
@@ -35,7 +35,7 @@
               (if (zero? ack-val)
                 state
                 (assoc state message-id (->Ack nil completion-id ack-val))))))]
-    (when (get rets message-id)
+    (when-not (get rets message-id)
       (>!! (:completions-ch daemon) {:id message-id
                                      :peer-id completion-id}))))


Use HTTPS for images

Use HTTPS for images

--- src/redbrick_20/components/data.cljs
+++ src/redbrick_20/components/data.cljs
@@ -67,13 +67,13 @@
     :year 1997
     :supporting-data "Valentines' Event in The Fleet (Shift a Trinner?).
                       Heres a picture of pooka have fun"
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
   }
   {
     :year 1998
     :supporting-data "Redbrick's machine \"mother\" goes live. Redbrick members are finally allowed to have
                       multiple accounts"
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
   }
   {
     :year 1999
@@ -82,7 +82,7 @@
                       possible for people to read other member's passwords and committee business. \n
                       Associate membership introduced with CSD's consent.
                       Redbrick's new machine, Enigma, running FreeBSD is launched"
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
   }
   {
     :year 2000
@@ -92,7 +92,7 @@
                       the same again in the day at rush hour. Redbrick also had a bouncy castle in DCU.
                       In association with Trad Soc we had an event in Whelans.
                       Trad soc, Jilted, Relish, Tea & Sympathy (American band) all played great sets."
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/9/91/Rbwiki_RedbrickLogo_tiny_logo.gif"
   }
   {
     :year 2001
@@ -103,12 +103,12 @@
                       tutorials are about writing webpages in HTML and using FTP to upload them to
                       redbrick. The third tutorial showed people how to setup Windowmaker and KDE
                       on their Solaris accounts in CA, as well as giving a basic introduction to commandline UNIX. "
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/f/f4/Rbwiki_RedbrickLogo_logo2.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/f/f4/Rbwiki_RedbrickLogo_logo2.gif"
   }
   {
     :year 2002
     :supporting-data "Redbrick gets a new logo."
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2003
@@ -116,7 +116,7 @@
                       Redbricks new server goes live and is named Deathray. The name is from a joke about
                       dimples using Redbrick's money to finance a death ray. or something.
                       Deathray becomes the primary login server, all logins now accepted at login.redbrick.dcu.ie, redbrick.dcu.ie is no more. "
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2004
@@ -124,18 +124,18 @@
                       Dcu.ie went down due to a serious hardware failure and perhaps
                       because people were constantly hitting the refresh key in the
                       hope that results would be released a day early. "
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2005
     :supporting-data "There is literally nothing of relevance on the wiki for this year :(."
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2006
     :supporting-data "The Redbrick Wiki was defaced by spammers. The wiki was temporarily taken down.
                       Redbrick celebrates its 10th birthday party in Bojangles nightclub, Harcourt st. "
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2007
@@ -144,7 +144,7 @@
                       The new Encom server goes through about a dozen names, before finally settling on
                       minerva.redbrick.dcu.ie, which apparently is \"horribly lame\".
                       /webtree is moved to minerva. No one notices, or is told. "
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2008
@@ -152,21 +152,21 @@
                       held in the Helix on Thursday 10th of April. Redbrick Chairperson Andrew Harford wins
                       a First Five award for Best Individual.
                       Redbrick wins Best Society Website of a Large College at the BICS Awards in Dundalk - Best Website in Ireland!"
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2009
     :supporting-data "RedBrick Twitter is launched to tell people about stuff.
                       DCUfm forget to renew their license. RedBrick pull the stream
                       for legal reasons."
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2010
     :supporting-data "Servers are taken offline to prepare for the move to our new server room. Minerva, Morpheus
                       and Worf are moved to ISS's server room in the library to maintain services during the downtime.
                       The brick is \"accidentally\" destroyed in the process. Meeting room 3 becomes Redbrick storage."
-    :supporting-image "http://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
+    :supporting-image "https://wiki.redbrick.dcu.ie/mw/images/2/29/Rbwiki_RedbrickLogo_logo2-rb.gif"
   }
   {
     :year 2011
@@ -186,7 +186,7 @@
   {
     :year 2013
     :supporting-data "The year space forgot the space #NeverForget :("
-    :supporting-image "http://www.redbrick.dcu.ie/includes/images/logo.png"
+    :supporting-image "https://www.redbrick.dcu.ie/includes/images/logo.png"
   }
   {
     :year 2014


Update doc index

Update doc index

--- src/doctopus/db.clj
+++ src/doctopus/db.clj
@@ -232,17 +232,6 @@
   (select documents
           (where {:tentacle_name (:name tentacle)})))

-(defn create-document!
-  [document]
-  (log/info "Creating new document named:" (:name document))
-  (insert documents
-          (values document)))
-
-;; Manually
-;; (let [sql (str/join ["UPDATE documents"
-;;                      "SET search_vector = to_tsvector('english', body)"
-;;                      "WHERE name = ?"] " ")]
-;;   (exec ))
 (defn update-document-index
   "The documents table has a column of type tsvector, `search_vector', which is
   indexed for Full Text Search; this function updates that column, for one
@@ -257,13 +246,20 @@
            (set-fields {:search-vector (raw "to_tsvector('english', body)")})
            (where {:name (:name document)}))))

+(defn create-document!
+  [document]
+  (log/info "Creating new document named:" (:name document))
+  (insert documents
+          (values document))
+  (update-document-index document))
+
 (defn update-document!
   [document update-index?]
   (log/info "Updating document named:" (:name document))
   (let [res (update documents
                     (set-fields document)
                     (where {:name (:name document)}))]
-    (if update-index? (update-document-index))
+    (if update-index? (update-document-index document))
     res))

 (defn save-document!


fix old UI routes

fix old UI routes

--- backend/src/lambdaui/core.clj
+++ backend/src/lambdaui/core.clj
@@ -44,10 +44,7 @@
         (context "/lambdaui/api" [] (new-api/api-routes pipeline))
         (POST "/lambdaui/api/triggerNew" request (do (runner/trigger-new-build pipeline request) {}))
         (GET "/" [] (old-ui/ui-page pipeline))
-        (context "/polling" [] (polling/polling-routes pipeline))
-        )
-      (context "/api" []
-        (old-api/rest-api pipeline)
+        (context "/api" [] (old-api/rest-api pipeline))
         ))))


Improve URL generation

Improve URL generation

--- src/icecap/rest.clj
+++ src/icecap/rest.clj
@@ -49,9 +49,10 @@
                                                    :kdf kdf
                                                    :scheme scheme))
                        encoded-cap (safebase64-encode cap)
-                       url (str "http://"
-                                (:server-name request) ":" (:port request)
-                                (:uri request) "/" encoded-cap)]
+                       netloc (str (:server-name request)
+                                   ":" (:server-port request))
+                       path (:uri request)
+                       url (str "http://" netloc path "/" encoded-cap)]
                    {:body {:cap encoded-cap :url url}}))
            (context "/:encoded-cap" [encoded-cap]
                     (GET "/" []


Make with-args* public so macro can be used in other nses.

--- src/incise/core.clj
+++ src/incise/core.clj
@@ -1,8 +1,6 @@
 (ns incise.core
-  (:require (incise [load :refer [load-parsers-and-layouts]]
-                    [config :as conf]
-                    [once :refer [once]]
-                    [utils :refer [delete-recursively]])
+  (:require (incise [config :as conf]
+                    [once :refer [once]])
             [incise.deploy.core :refer [deploy]]
             [taoensso.timbre :refer [warn]]
             [clojure.string :as s]
@@ -20,7 +18,7 @@
                    (s/join ", " valid-methods) "). Defaulting to serve.")))
       :serve)))

-(defn- with-args*
+(defn with-args*
   "A helper function to with-args macro which does all the work.

   1.  Parse arguments


Remove unused -atom rule.

Remove unused -atom rule.

--- src/isla/parser.clj
+++ src/isla/parser.clj
@@ -8,7 +8,7 @@

 (declare expression-types atom-types value-types
          parse matched-nodes is-type pattern-sequence
-         -root -block -expression -atom -assignment
+         -root -block -expression -assignment -invocation
          -nl -integer -is -string -assignee -value -identifier)

 (defn parse [code]
@@ -77,11 +77,6 @@

 ;; atoms

-(defn -atom [token]
-  (def nodes (matched-nodes token atom-types))
-  (if (> (count nodes) 0)
-    (first nodes) ;; return first match
-    (throw (Exception. (str "Could not identify: " token)))))

 (defn -nl [token]
   (if (is-type :nl token)


rewrote acceptance/new_stress_tests.clj to use dire handlers

--- test/acceptance/new_stress_tests.clj
+++ test/acceptance/new_stress_tests.clj
@@ -4,6 +4,7 @@
             [com.climate.claypoole.lazy :as lazy]
             [acceptance.util :as util]
             [push.util.code-wrangling :as fix]
+            [dire.core :refer [with-handler!]]
             )
   (:use midje.sweet)
   )
@@ -12,13 +13,25 @@
 ;;;; setup

 (def my-interpreter (push/interpreter))
-(def cohort-size 10000)
+(def cohort-size 100)
 (def program-size 1000)
 (def erc-scale 10)
 (def erc-prob 3/5)

 ;;;;
+
+(defn run-program-in-standardized-interpreter
+  [interpreter program bindings]
+    (push/run
+      interpreter
+      program
+      20000
+      :bindings bindings
+      :config {:step-limit 20000
+               :lenient true
+               :max-collection-size 138072} ;138072
+               ))

 (defn spit-prisoner-file
   [program bindings exception-message]
@@ -34,34 +47,37 @@
         :bindings bindings}
         )))

+         ; (try
+         ;   (catch StackOverflowError e
+         ;     (println
+         ;       (str "\n\nSTACK OVERFLOW >>>>>>> "
+         ;            "\n:exec stack: " (push/get-stack interpreter :exec)
+         ;            "\n:log stack:  " (push/get-stack interpreter :log)
+         ;            "\n:counter:    " (:steps interpreter)))
+         ;     (spit-prisoner-file program bindings (.getMessage e))
+         ;     ;(throw (Exception. (.getMessage e)))
+         ;     )
+         ;   (catch Exception e
+         ;     (println (str e))
+         ;     :other-exception
+         ;     )
+         ;   ; (finally
+         ;   ;   (println (str "\n\n running: " program)))
+         ;     ))

-
-(defn run-program-in-standardized-interpreter
-  [interpreter program bindings]
-  (try
-    (push/run
-      interpreter
-      program
-      20000
-      :bindings bindings
-      :config {:step-limit 20000 :lenient true :max-collection-size 138072}) ;138072
-    (catch StackOverflowError e
+(with-handler! #'run-program-in-standardized-interpreter
+  "If an interpreter raises an exception, dump a new prisoner file."
+  [java.lang.StackOverflowError, java.lang.NullPointerException]
+  (fn [e & args]
+    (do
       (println
-        (str "\n\nSTACK OVERFLOW >>>>>>> "
-             "\n:exec stack: " (push/get-stack interpreter :exec)
-             "\n:log stack:  " (push/get-stack interpreter :log)
-             "\n:counter:    " (:steps interpreter)))
-      (spit-prisoner-file program bindings (.getMessage e))
-      ;(throw (Exception. (.getMessage e)))
-      )
-    (catch Exception e
-      (println (str e))
-      :other-exception
-      )
-    ; (finally
-    ;   (println (str "\n\n running: " program)))
-      ))
-
+        (str "\n\nSTACK OVERFLOW >>>>>>> " args))
+      (println "\n\n saving prisoner: ")
+      (spit-prisoner-file
+        (first args)
+        (second args)
+        (.getMessage e)))
+        ))

 (defn interpreter-details
@@ -120,7 +136,7 @@
 (defn launch-some-workers
   [interpreter bindings numbered-programs]
   (doall
-    (map
+    (cp/upmap 2
       #(.write *out*
         (str "\n\n"
           (first %) ": "
@@ -133,16 +149,9 @@
       ))

-(future-fact "run some workers in parallel"
+(fact "run some workers in parallel"
   :danger :parallel
   (launch-some-workers
     my-interpreter
     sample-bindings
     sample-programs) =not=> (throws))
-
-
-;;;RISKY
-    ; (launch-some-workers
-    ;   my-interpreter
-    ;   sample-bindings
-    ;   sample-programs)


Fix Error Reporting Issue

Fix Error Reporting Issue

--- src/lens/import.clj
+++ src/lens/import.clj
@@ -6,7 +6,7 @@
             [lens.api :as api]))

 (defn- assoc-xf [& kvs]
-  (map #(apply assoc % kvs)))
+  (map #(if (instance? Throwable %) % (apply assoc % kvs))))

 (def FormRef
   {:study-id s/Str


Remove Unnecessary Functions from Liberator Handlers

--- src/lens/routes.clj
+++ src/lens/routes.clj
@@ -84,9 +84,8 @@
      :id (:workbook/id workbook)})

   :handle-not-found
-  (fn [_]
-    {:links {:up {:href (service-document-path)}}
-     :error "Workbook not found."}))
+  {:links {:up {:href (service-document-path)}}
+   :error "Workbook not found."})

 ;; ---- Create Workbook -------------------------------------------------------

@@ -136,9 +135,8 @@
   (fnk [branch] (branch-path branch))

   :handle-not-found
-  (fn [_]
-    {:links {:up {:href (service-document-path)}}
-     :error "Workbook not found."}))
+  {:links {:up {:href (service-document-path)}}
+   :error "Workbook not found."})

 ;; ---- Add Query -------------------------------------------------------------

@@ -220,14 +218,12 @@
      {:lens/update-branch (update-branch-form branch)}})

   :handle-not-found
-  (fn [_]
-    {:links {:up {:href (service-document-path)}}
-     :error "Branch not found."})
+  {:links {:up {:href (service-document-path)}}
+   :error "Branch not found."}

   :handle-precondition-failed
-  (fn [_]
-    {:links {:up {:href (service-document-path)}}
-     :error "Precondition failed."}))
+  {:links {:up {:href (service-document-path)}}
+   :error "Precondition failed."})

 ;; ---- Branch List -----------------------------------------------------------


Fix a typo in the DTBook template

Fix a typo in the DTBook template

--- src/mdr2/dtbook.clj
+++ src/mdr2/dtbook.clj
@@ -11,34 +11,34 @@
   [:dtbook {:xmlns "http://www.daisy.org/z3986/2005/dtbook/"
             :version "2005-3" :xml:lang language}
    [:head
-    [:head {:name "dc:Title" :content title}]
-    [:head {:name "dc:Creator" :content creator}]
-    [:head {:name "dc:Subject" :content subject}]
-    [:head {:name "dc:Description" :content description}]
-    [:head {:name "dc:Publisher" :content publisher}]
-    [:head {:name "dc:Date" :content date}]
-    [:head {:name "dc:Type" :content "Text"}]
-    [:head {:name "dc:Format" :content "ANSI/NISO Z39.86-2005"}]
-    [:head {:name "dc:Identifier" :content identifier}]
-    [:head {:name "dc:Source" :content source}]
-    [:head {:name "dc:Language" :content language}]
-    [:head {:name "dc:Rights" :content rights}]
-    [:head {:name "dtb:uid" :content identifier}]
-    [:head {:name "dtb:sourceDate" :content sourceDate}]
-    [:head {:name "dtb:sourceEdition" :content sourceEdition}]
-    [:head {:name "dtb:sourcePublisher" :content sourcePublisher}]
-    [:head {:name "dtb:sourceRights" :content sourceRights}]
-    [:head {:name "dtb:sourceTitle" :content sourceTitle}]
-    [:head {:name "dtb:multimediaType" :content multimediaType}]
-    [:head {:name "dtb:multimediaContent" :content multimediaContent}]
-    [:head {:name "dtb:narrator" :content narrator}]
-    [:head {:name "dtb:producer" :content publisher}]
-    [:head {:name "dtb:producedDate" :content producedDate}]
-    [:head {:name "dtb:revision" :content revision}]
-    [:head {:name "dtb:revisionDate" :content revisionDate}]
-    [:head {:name "dtb:revisionDescription" :content revisionDescription}]
-    [:head {:name "dtb:totalTime" :content totalTime}]
-    [:head {:name "dtb:audioFormat" :content audioFormat}]]
+    [:meta {:name "dc:Title" :content title}]
+    [:meta {:name "dc:Creator" :content creator}]
+    [:meta {:name "dc:Subject" :content subject}]
+    [:meta {:name "dc:Description" :content description}]
+    [:meta {:name "dc:Publisher" :content publisher}]
+    [:meta {:name "dc:Date" :content date}]
+    [:meta {:name "dc:Type" :content "Text"}]
+    [:meta {:name "dc:Format" :content "ANSI/NISO Z39.86-2005"}]
+    [:meta {:name "dc:Identifier" :content identifier}]
+    [:meta {:name "dc:Source" :content source}]
+    [:meta {:name "dc:Language" :content language}]
+    [:meta {:name "dc:Rights" :content rights}]
+    [:meta {:name "dtb:uid" :content identifier}]
+    [:meta {:name "dtb:sourceDate" :content sourceDate}]
+    [:meta {:name "dtb:sourceEdition" :content sourceEdition}]
+    [:meta {:name "dtb:sourcePublisher" :content sourcePublisher}]
+    [:meta {:name "dtb:sourceRights" :content sourceRights}]
+    [:meta {:name "dtb:sourceTitle" :content sourceTitle}]
+    [:meta {:name "dtb:multimediaType" :content multimediaType}]
+    [:meta {:name "dtb:multimediaContent" :content multimediaContent}]
+    [:meta {:name "dtb:narrator" :content narrator}]
+    [:meta {:name "dtb:producer" :content publisher}]
+    [:meta {:name "dtb:producedDate" :content producedDate}]
+    [:meta {:name "dtb:revision" :content revision}]
+    [:meta {:name "dtb:revisionDate" :content revisionDate}]
+    [:meta {:name "dtb:revisionDescription" :content revisionDescription}]
+    [:meta {:name "dtb:totalTime" :content totalTime}]
+    [:meta {:name "dtb:audioFormat" :content audioFormat}]]
    [:book
     [:frontmatter
      [:doctitle title]


Apply macro bindings during loading

Apply macro bindings during loading

Use the new core-redefs toolbox to handle various forms in clojure.core
more nicely (or not at all).

--- src/oxcart/core.clj
+++ src/oxcart/core.clj
@@ -23,7 +23,9 @@
             [clojure.string :as s]
             [clojure.tools.reader :as r]
             [clojure.tools.reader.reader-types :as readers]
-            [oxcart.util :as util])
+            [oxcart.vars :refer :all]
+            [oxcart.util :as util]
+            [oxcart.core-redefs])
   (:import clojure.lang.IFn))

@@ -175,13 +177,24 @@
                  *load-configuration* options]
          (with-redefs [clojure.core/load   oxcart.core/load
                        clojure.core/eval   oxcart.core/eval
-                       clojure.core/gensym oxcart.core/gensym]
+                       clojure.core/gensym oxcart.core/gensym
+
+                       ;; FIXME:
+                       ;;   macro(s) taken as value via var(s)
+                       clojure.core/ns              @#'oxcart.core-redefs/ns
+                       clojure.core/defmulti        @#'oxcart.core-redefs/defmulti
+                       clojure.core/defmethod       @#'oxcart.core-redefs/defmethod
+                       clojure.core/deftype         @#'oxcart.core-redefs/deftype
+                       clojure.core/defprotocol     @#'oxcart.core-redefs/defprotocol
+                       clojure.core/proxy           @#'oxcart.core-redefs/proxy
+                       clojure.core/extend-type     @#'oxcart.core-redefs/extend-type
+                       clojure.core/extend-protocol @#'oxcart.core-redefs/extend-protocol]
            (loop []
              (let [form (r/read reader false eof)]
                (when (not= eof form)
                  (eval form options)
                  (recur)))))))
-     nil))
+  nil))

 (defn compile


Improve error handling.

Improve error handling.

--- src/potok/core.cljs
+++ src/potok/core.cljs
@@ -89,11 +89,9 @@
 (defn- default-error-handler
   [error]
   (js/console.warn "Using default error handler, consider using your own!")
-  (js/console.error error)
-  (rx/throw error))
+  (js/console.error error))

 (def ^:private noop (constantly nil))
-(def ^:private max-safe-integer js/Number.MAX_SAFE_INTEGER)

 ;; --- Public API

@@ -102,59 +100,55 @@

   This function initializes a new event processing stream
   loop and returns a bi-directional rx stream that should
-  be used to push new events and subscribe to state changes.
-
-  You probably should not be using this function directly,
-  because a default store is already instanciated
-  under the `stream` var. This function is indented to be
-  used for advanced use cases, where one store is not
-  enough."
+  be used to push new events and subscribe to state changes."
   ([] (store nil))
   ([{:keys [on-error state] :or {on-error default-error-handler}}]
    {:pre [(fn? on-error)]}
-   (letfn [(process-watch [input-sub [event state]]
-             (watch event state input-sub))
-           (process-update [input-sub state event]
+   (letfn [(process-update [input-sub state event]
              (update event state))
+           (process-watch [input-sub [event state]]
+             (let [result (watch event state input-sub)]
+               (if (nil? result)
+                 (rx/empty)
+                 result)))
            (handle-effect [input-sub [event state]]
              (effect event state input-sub))
-           (handle-error [error]
-             (on-error error)
-             (rx/throw error))]
+           (handle-error [error source]
+             (try
+               (on-error error)
+               (catch :default e))
+             source)]
+
      (let [input-sb (rx/subject)
+           input-sm (rx/as-observable input-sb)
            state-sb (rx/behavior-subject state)
-           state-sm (->> (rx/filter update? input-sb)
-                         (rx/scan (partial process-update input-sb) state)
-                         (rx/catch handle-error)
-                         (rx/retry max-safe-integer))
-           watch-sm (->> (rx/filter watch? input-sb)
-                         (rx/with-latest vector state-sb)
-                         (rx/flat-map (partial process-watch input-sb))
-                         (rx/catch handle-error)
-                         (rx/retry max-safe-integer))
-           effct-sm (->> (rx/filter effect? input-sb)
-                         (rx/with-latest vector state-sb)
-                         (rx/do (partial handle-effect input-sb))
-                         (rx/catch handle-error)
-                         (rx/retry max-safe-integer))
-           subs     (rx/subscribe-with state-sm state-sb)
-           subw     (rx/subscribe-with watch-sm input-sb)
-           sube     (rx/subscribe effct-sm noop)
-           stoped?  (volatile! false)]
+
+           update-sm (->> (rx/filter update? input-sm)
+                          (rx/scan #(process-update input-sm %1 %2) state)
+                          (rx/catch handle-error))
+           watch-sm  (->> (rx/filter watch? input-sm)
+                          (rx/with-latest vector state-sb)
+                          (rx/flat-map #(process-watch input-sm %))
+                          (rx/catch handle-error))
+           effect-sm (->> (rx/filter effect? input-sm)
+                          (rx/with-latest vector state-sb)
+                          (rx/do #(handle-effect input-sm %))
+                          (rx/catch handle-error))
+
+           subs (rx/subscribe-with update-sm state-sb)
+           subw (rx/subscribe-with watch-sm input-sb)
+           sube (rx/subscribe effect-sm noop)]
+
        (specify! state-sb
          Store
          (-push [_ event]
-           (when @stoped? (throw (ex-info "store already terminated" {})))
            (rx/push! input-sb event))

          (-input-stream [_]
-           (->> input-sb
-                (rx/map identity)
-                (rx/share)))
+           (rx/as-observable input-sb))

          rx/ICancellable
          (-cancel [_]
-           (vreset! stoped? true)
            (rx/cancel! subs)
            (rx/cancel! subw)
            (rx/cancel! sube)


remove duped code

remove duped code

--- src/jsx_fun/core.clj
+++ src/jsx_fun/core.clj
@@ -55,16 +55,6 @@
       nil root)
     (.toSource comp root)))

-(defn transform-commonjs
-  [filename src]
-  (let [js      [(SourceFile/fromCode filename src)]
-        options (set-options {:lang-in :es5 :pretty-print true}
-                  (CompilerOptions.))
-        comp    (doto (cl/make-closure-compiler)
-                  (.init '() js options))
-        root    (.parse comp (first js))]
-    (.toSource comp root)))
-
 (defn node-visitor []
   (reify
     NodeUtil$Visitor


explain current state, switching contexts

--- src/jsx_fun/core.clj
+++ src/jsx_fun/core.clj
@@ -235,6 +235,11 @@
       "<cmd>" 1 nil))

   ;; undefined
+  ;; this is because Babel shims Symbol and hasSymbol flag gets set to true
+  ;; in the isNaN module which then assumes Object.getOwnPropertySymbols
+  ;; works.
+  ;; it appears Object.getOwnPropertySymbols should also get shimmed but this
+  ;; doesn't seem to be the case for some reason.
   (let [cx     (Context/enter)
         _      (.setOptimizationLevel cx -1)
         scope  (.initStandardObjects cx)


mean the centroids each iterations

mean the centroids each iterations

--- src/k_means/core.clj
+++ src/k_means/core.clj
@@ -12,19 +12,31 @@
 (defn still-moving?
   "Predicate to test if the centroids have not reached equlibrium"
   [t c]
-  (= t c))
+  (not (= t c)))

 (defn mean
   "Retrieve the mean value of a list"
   [l]
-  (/ (reduce + l) (count l)))
+  (float (/ (reduce + l) (count l))))
+
+(defn mean-2dvec
+  [v]
+  (let [
+    a (map first v)
+    b (flatten (map rest v))
+    x (float (/ (reduce + a) (count a)))
+    y (float (/ (reduce + b) (count b)))]
+    [x y]))

 ;; This is the next method which will be implemented...
 (defn mean-centroids
   "Calculates the mean for a given centroid"
   ([g] (mean-centroids g []))
   ([g l]
-    g))
+    (cond
+      (empty? g) l
+      :else
+        (recur (rest g) (conj l (mean-2dvec (first g)))))))

 (defn distance
   "Implements euclidian distance between two vectors"
@@ -66,17 +78,19 @@

 (defn k-means
   "Perform the actual k-means"
-  ([l k]
-    (k-means l k (choose-initial-centroids l k) (make-vector k)))
-  ([l k c g]
+  ([l k max-iterations]
+    (k-means l k (choose-initial-centroids l k) (make-vector k) max-iterations))
+  ([l k c g max-iterations]
     (let [t c g (cluster g l c) c (mean-centroids g)]
-      ; (println g)
+      (println t c (= t c))
+      ; (println (still-moving? t c))
       (cond
+        (> 0 max-iterations) g
         (still-moving? t c) ; Keep shifting centroids until equilibrium
-          (recur l k c g)
+          (recur l k c g (dec max-iterations))
         :else g))))

 (defn -main
   "Main function for k-means"
   [& args]
-  (let [c (k-means [[1 2] [3 2] [6 3] [1 8] [9 10] [1 4] [56 67] [44 53] [43 54] [43 64] [76 56]] 2)] (println c)))
+  (let [c (k-means [[1 2] [3 2] [6 3] [1 8] [9 10] [1 4] [56 67] [44 53] [43 54] [43 64] [76 56]] 3 100)] (println c)))


Removed the all-important catchphrase.

Removed the all-important catchphrase.

--- src/ackbar/core.clj
+++ src/ackbar/core.clj
@@ -1,5 +1,3 @@
-;; It's a Trap!
-
 (ns ackbar.core
   (:use compojure.core hiccup.core hiccup.form-helpers hiccup.page-helpers)
   (:require [appengine-magic.core :as ae]))


Cleaning up a bit

Cleaning up a bit

--- clojure/dbmgmt/src/dbmgmt.clj
+++ clojure/dbmgmt/src/dbmgmt.clj
@@ -43,6 +43,8 @@
     {:error "Exception" :fn "parse-config" :exception (.getMessage e)})))

 ;; db
+
+;; nil if enything goes sideways

 (def db-prod-eu
   (:eu
@@ -92,19 +94,19 @@
   []
   (.getInputArguments (ManagementFactory/getRuntimeMXBean)))

+(defn exec
+  []
+  (println (str "Start time :: " (start-time)))
+  (println (str "Input args :: " (get-input-args)))
+  (println (str "now :: " (.getString (exec-sql) "now"))))
+
 (defn -handleRequest ^String [this in ctx]
   (reify RequestHandler
     (handleRequest ^String [this in ctx]
       (let [logger (.getLogger ctx)]
-        (.log (str "Start time :: " (start-time)))
-        (println (str "Start time :: " (start-time)))
-        (.log (str "Input args :: " (get-input-args)))
-        (println (str "Input args :: " (get-input-args)))
-        (.log logger (str "now :: " (.getString (exec-sql) "now")))
-        (println logger (str "now :: " (.getString (exec-sql) "now"))))
-      "ok")))
+        (.log logger "Hello from logging")
+        (exec)))))

-(defn -main [& args]
-  (println (str "Start time :: " (start-time)))
-  (println (str "Input args :: " (get-input-args)))
-  (println (str "now :: " (.getString (exec-sql) "now"))))
+(defn -main
+  [& args]
+  (exec))


Comments

Comments

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -1,4 +1,8 @@
 ;; Copyright © 2013, JUXT LTD. All Rights Reserved.
+
+;; This is a slide presentation using ClojureScript and Om. Please feel
+;; free to make use of this code for your own presentations.
+
 (ns qcon.main
   (:require-macros [cljs.core.async.macros :refer [go go-loop]])
   (:require


Fix infinite loop.

Fix infinite loop.

--- src/cgdata/core.clj
+++ src/cgdata/core.clj
@@ -502,15 +502,16 @@
   :strand are reused if necessary."
   [columns start-index]
   (let [poscols (select-keys (group-by :header columns) position-columns)                ; columns matching position types.
-        poscols (update-in poscols [:chrom] #(concat % (repeat (last %))))               ; repeat last chrom if necessary.
-        poscols (update-in poscols [:strand] #(concat % (repeat (last %))))              ; repeat last strand if necessary.
+        limit (apply max (map count (vals poscols)))
+        poscols (update-in poscols [:chrom] #(take limit (concat % (repeat (last %)))))  ; repeat last chrom if necessary.
+        poscols (update-in poscols [:strand] #(take limit (concat % (repeat (last %))))) ; repeat last strand if necessary.
         positions (filter #(every? (set (map :header %)) [:chrom :chromStart :chromEnd]) ; find groups with the required fields.
-                          (apply map vector (vals poscols)))                             ;   collate into groups.
+                           (apply map vector (vals poscols)))                            ;   collate into groups.
         consumed (set (apply concat positions))]                                         ; columns used by position fields.
     (into (mapv #(-> {:type :position
                       :start-index start-index
                       :header :position
-                      :columns (filter identity %)}) ; write out position field specs.
+                      :columns (filter identity %)})                                     ; write out position field specs.
                 positions)
           (filter (comp not consumed) columns))))                                        ;   append all remaining fields.

@@ -659,10 +660,13 @@
 (def probemap-columns
   {#"(?i)chr(om)?" :chrom
    #"(?i)start" :chromStart
+   #"(?i)chromStart" :chromStart
    #"(?i)end" :chromEnd
+   #"(?i)chromEnd" :chromEnd
    #"(?i)strand" :strand
    #"(?i)genes?" :genes
-   #"(?i)name" :name})
+   #"(?i)name" :name
+   #"(?i)id" :name})

 ; XXX refactor this function pattern. It appears three times.
 (defn probemap-file


refactoring

refactoring

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -171,30 +171,30 @@
   (POST "/rest/v2/login" {params :params headers :headers}
         (let [username (:username params)
               password (:password params)
-              new-location (if-let [referer (headers "referer")] referer "/m/index.html")]
+              redirect-location (if-let [referer (headers "referer")] referer "/m/index.html")]
           (if (authenticate username password)
             (let [case-user (user/get-case-user username)
                   authToken (auth-token case-user)
                   authUser (:username (user/get-case-user username))]
               {:status 301
                :headers {"Content-Type" "text/html"
-                         "Location" new-location}
+                         "Location" redirect-location}
                :cookies {"authToken" {:value authToken :max-age (* 60 60 24 2 365) }
                          "authUser" {:value authUser :max-age  (* 60 60 24 2 365) }}
                :body ""
                })
             {:status 301
              :headers {"Content-Type" "text/html"
-                       "Location" (str new-location "?status=login_failed")
+                       "Location" (str redirect-location "?status=login_failed")
                        "X-Ontrail-Status" "login-failed"}
              :body ""
              })))

   (POST "/rest/v2/logout" {headers :headers}
-        (let [new-location (if-let [referer (headers "referer")] referer "/m/index.html")]
+        (let [redirect-location (if-let [referer (headers "referer")] referer "/m/index.html")]
           {:status 301
            :headers {"Content-Type" "text/html"
-                     "Location" new-location}
+                     "Location" redirect-location}
            :cookies {"authToken" {:value "" :max-age 0}
                      "authUser" {:value "" :max-age  0 }}
            :body ""}))


first pass for :paredit-wrap-round

first pass for :paredit-wrap-round

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -22,14 +22,14 @@

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

-#_(defn spy*
+(defn spy*
   [msg expr]
   `(let [expr# ~expr]
      (do
        (println (str "::::spying[" ~msg "]:::: " '~expr ":::: '" expr# "'"))
        expr#)))

-#_(defmacro spy
+(defmacro spy
   ([expr] (spy* "" expr))
   ([msg expr] (spy* msg expr)))

@@ -374,6 +374,30 @@
                  "|",
                 "(foo \"|bar baz\"\n     quux)"
                  "(foo \"|\"\n     quux)"}]]
+
+    ["Depth-Changing Commands"
+     ["M-("       :paredit-wrap-round
+      {"(foo |bar baz)" "(foo (|bar) baz)",
+       ";hel|lo" ";hel|lo",
+       "a |\"hi\"" "a (|\"hi\")"}]
+     ;["M-s"       :paredit-splice-sexp
+     ;           {"(foo (bar| baz) quux)"
+     ;            "(foo bar| baz quux)"}]
+     ;[("M-<up>" "ESC <up>")
+     ;           paredit-splice-sexp-killing-backward
+     ;           ("(foo (let ((x 5)) |(sqrt n)) bar)"
+     ;            "(foo (sqrt n) bar)")]
+     ;(("M-<down>" "ESC <down>")
+     ;           paredit-splice-sexp-killing-forward
+     ;           ("(a (b c| d e) f)"
+     ;            "(a b c f)"))
+     ;("M-r"       paredit-raise-sexp
+     ;           ("(dynamic-wind in (lambda () |body) out)"
+     ;            "(dynamic-wind in |body out)"
+     ;            "|body"))
+     ]
+
+
     ["Miscellaneous"
       ["Tab"     :paredit-indent-line
                 {"[a\n|b]"  "[a\n |b]"
@@ -789,6 +813,23 @@
                         (update-in t [:offset] + (max to-add (- line-start offset)))))))))
     t))

+(defmethod paredit
+  :paredit-wrap-round
+  [cmd {:keys [#^String text offset length] :as t}]
+  (let [parsed (parse text)]
+    (if-not (in-code? parsed)
+      (spy 1 t)
+      (if-let [rloc (-?> parsed (parsed-root-loc true))]
+        (let [leave (some (fn [l] (when (not= " " (loc-tag l)) l)) (next-leaves (loc-for-offset rloc offset)))]
+          (if (not= (start-offset leave) (start-offset (zip/up leave)))
+            (spy 2 t)
+            (let [text-to-wrap (.substring text (start-offset (zip/up leave)) (end-offset (zip/up leave)))
+                  new-text (str "(" text-to-wrap ")")
+                  t (update-in t [:text] str-replace (start-offset leave) (.length text-to-wrap) new-text)
+                  t (assoc-in t [:offset] (inc (start-offset leave)))]
+              (spy 3(update-in t [:modifs] conj {:text new-text :offset (start-offset leave) :length (.length text-to-wrap)})))))
+        (spy 4 t)))))
+
 (defn test-command [title-prefix command]
   (testing (str title-prefix " " (second command) " (\"" (first command) "\")")
     (doseq [[input expected] (get command 2)]


change back to app

change back to app

--- src/redchat/core.clj
+++ src/redchat/core.clj
@@ -17,5 +17,5 @@
   ;;  (info "port is " (env :port))
   (let [host (args "host")
         port (Integer. (or (args "port") (env :port) 5000))]
-    (s/run h/heroku {:port port
-                     :host host})))
+    (s/run h/app {:port port
+                  :host host})))


Many small updates to dolly.clone namespace

--- src/dolly/clone.clj
+++ src/dolly/clone.clj
@@ -6,6 +6,18 @@
   (:import (java.io File)))

+(defn abbreviate-path
+  "If the string pathname begins with the string to-abbrev (followed
+by the File path separator string), replace that portion of the path
+name with the abbreviation abbrev (followed by the FIle path separator
+string) and return that.  Otherwise return pathname."
+  [^String pathname to-abbrev abbrev]
+  (if (and (string? abbrev)
+           (.startsWith pathname (str to-abbrev File/separator)))
+    (str abbrev (subs pathname (count to-abbrev)))
+    pathname))
+
+
 (defn copy-ns-file
   "Copies the .clj source file (found relative to source-path) for the
 namespace named by the symbol ns-sym to a file for the same namespace,
@@ -13,28 +25,24 @@

 WARNING: This function can overwrite any source file that was already
 at the destination!  Make sure you have a backup or version control."
-  [source-path ns-sym dest-path & [dry-run? source-path-abbrev dest-path-abbrev]]
+  [source-path ns-sym dest-path opts]
   (let [ns-fname (#'move/ns-file-name ns-sym)
         old-file (io/file source-path ns-fname)
         new-file (io/file dest-path ns-fname)]
-    (if dry-run?
-      (str (format "mkdir %s\n"
-                   (let [full-path (str (.getParentFile new-file))]
-                     (if dest-path-abbrev
-                       (str/replace-first full-path
-                                          (str dest-path File/separator)
-                                          dest-path-abbrev)
-                       full-path)))
-           (format "copy %s %s\n"
-                   (if source-path-abbrev
-                     (str source-path-abbrev ns-fname)
-                     (str old-file))
-                   (if dest-path-abbrev
-                     (str dest-path-abbrev ns-fname)
-                     (str new-file))))
-      (do
-        (.mkdirs (.getParentFile new-file))
-        (io/copy old-file new-file)))))
+    (when (:print? opts)
+      (println (format "mkdir %s"
+                       (abbreviate-path (str (.getParentFile new-file))
+                                        dest-path (:dest-path-abbrev opts)))))
+    (when-not (:dry-run? opts)
+      (.mkdirs (.getParentFile new-file)))
+    (when (:print? opts)
+      (println (format "copy %s %s"
+                       (abbreviate-path (str old-file) source-path
+                                        (:source-path-abbrev opts))
+                       (abbreviate-path (str new-file) dest-path
+                                        (:dest-path-abbrev opts)))))
+    (when-not (:dry-run? opts)
+      (io/copy old-file new-file))))

 (defn namespace-to-copy? [ns root-ns]
@@ -59,37 +67,32 @@
 For example, if source-path is /source/path and it contains a file
 /source/path/one/two.clj, it will be an error if the namespace inside
 is anything other than 'one.two'."
-  [source-path ns-sym dest-path dry-run?]
+  [source-path ns-sym dest-path opts]
   (let [ns-info (ns/namespaces-in-dirs {:paths [source-path]})]
     (if (:err ns-info)
       ns-info
-      (if dry-run?
-        {:err nil
-         :dry-run-msgs
-         (cons
-          (format "Copy Clojure source files in namespace %s unmodified\n  from source path S='%s'\n  to dest path D='%s'\n"
-                  ns-sym source-path dest-path)
-          (for [[file ns] (:clojure.tools.namespace.file/filemap ns-info)]
-            (let [source-path-abbrev (str "S" File/separator)
-                  dest-path-abbrev (str "D" File/separator)]
-              (if (namespace-to-copy? ns ns-sym)
-                (copy-ns-file source-path ns dest-path
-                              dry-run? source-path-abbrev dest-path-abbrev)
-                (format "Don't copy namespace %s from S since it is not a 'sub-namespace' of %s\n"
-                        ns ns-sym)))))}
+      (do
+        (when (:print? opts)
+          (println (format "Copy Clojure source files in namespace %s unmodified\n  from source path S='%s'\n  to dest path D='%s'"
+                           ns-sym source-path dest-path)))
         (doseq [[file ns] (:clojure.tools.namespace.file/filemap ns-info)]
-          (when (namespace-to-copy? ns ns-sym)
-            (copy-ns-file source-path ns dest-path dry-run?)))))))
+          (if (namespace-to-copy? ns ns-sym)
+            (copy-ns-file source-path ns dest-path
+                          (merge opts {:source-path-abbrev "S"
+                                       :dest-path-abbrev "D"}))
+            (when (:print? opts)
+              (println (format "Don't copy namespace %s from S since it is not a 'sub-namespace' of %s"
+                               ns ns-sym)))))))))

 (comment
 (require '[dolly.clone :as c])
 (def tns-path "/Users/jafinger/clj/dolly/copy-deps/tools.namespace/src/main/clojure")
 (def staging-path "/Users/jafinger/clj/dolly/staging")
-(def o1 (c/copy-namespaces-unmodified tns-path 'clojure.tools.namespace staging-path true))
-(print (apply str (:dry-run-msgs o1)))
-(def o2 (c/copy-namespaces-unmodified tns-path 'clojure.tools.namespace.dir staging-path true))
-(print (apply str (:dry-run-msgs o2)))
+(def o1 (c/copy-namespaces-unmodified tns-path 'clojure.tools.namespace staging-path {:dry-run? true :print? true}))
+;;(print (apply str (:dry-run-msgs o1)))
+(def o2 (c/copy-namespaces-unmodified tns-path 'clojure.tools.namespace.dir staging-path {:dry-run? true :print? true}))
+;;(print (apply str (:dry-run-msgs o2)))
 )

@@ -131,17 +134,38 @@

   WARNING: This function moves and deletes your source files!  Make
   sure you have a backup or version control."
-  [old-sym new-sym source-path dest-path]
-  ;; TBD: Add dry run option
+  [old-sym new-sym source-path dest-path opts]
   (let [old-file (io/file source-path (#'move/ns-file-name old-sym))
         new-file (io/file dest-path (#'move/ns-file-name new-sym))]
-    (.mkdirs (.getParentFile new-file))
-    (io/copy old-file new-file)
-    (.delete old-file)
-    (loop [dir (.getParentFile old-file)]
-      (when (empty? (.listFiles dir))
-        (.delete dir)
-        (recur (.getParentFile dir))))))
+    (when (:print? opts)
+      (println (format "mkdir %s"
+                       (abbreviate-path (str (.getParentFile new-file))
+                                        dest-path (:dest-path-abbrev opts)))))
+    (when-not (:dry-run? opts)
+      (.mkdirs (.getParentFile new-file)))
+    (when (:print? opts)
+      (println (format "copy %s %s"
+                       (abbreviate-path (str old-file)
+                                        source-path (:source-path-abbrev opts))
+                       (abbreviate-path (str new-file)
+                                        dest-path (:dest-path-abbrev opts)))))
+    (when-not (:dry-run? opts)
+      (io/copy old-file new-file))
+    (when (:print? opts)
+      (println (format "delete %s"
+                       (abbreviate-path (str old-file)
+                                        source-path (:source-path-abbrev opts)))))
+    (when-not (:dry-run? opts)
+      (.delete old-file))
+    (when (:print? opts)
+      (println (format "delete old dir %s if empty"
+                       (abbreviate-path (str (.getParentFile old-file))
+                                        source-path (:source-path-abbrev opts)))))
+    (when-not (:dry-run? opts)
+      (loop [dir (.getParentFile old-file)]
+        (when (empty? (.listFiles dir))
+          (.delete dir)
+          (recur (.getParentFile dir)))))))

 (defn replace-ns-symbol
@@ -211,15 +235,9 @@
 (require '[dolly.clone :as c])
 (def tns-path "/Users/jafinger/clj/dolly/copy-deps/tools.namespace/src/main/clojure")
 (def staging-path "/Users/jafinger/clj/dolly/staging")
-(def o1 (c/update-file (str tns-path "/clojure/tools/namespace.clj")
-                       {:dry-run? true}
-                       c/replace-ns-symbol
-                       'clojure.tools.namespace
-                       'eastwood.copieddeps.tns.clojure.tools.namespace))
 (def o1 (c/update-file (str tns-path "/clojure/tools/namespace.clj") {:dry-run? true} c/replace-ns-symbol 'clojure.tools.namespace 'eastwood.copieddeps.tns.clojure.tools.namespace))
-(pprint o1)
-(def o2 (c/copy-namespaces-unmodified tns-path 'clojure.tools.namespace.dir staging-path true))
-(print (apply str (:dry-run-msgs o2)))
+(def m1 (into (sorted-map) (:symbols o1)))
+(pprint m1)
 )

@@ -243,7 +261,7 @@
   sure you have a backup or version control."
   [old-sym new-sym source-path dest-path dirs opts]
   ;; TBD: Add dry run option
-  (move-ns-file old-sym new-sym source-path dest-path)
+  (move-ns-file old-sym new-sym source-path dest-path opts)
   (doseq [file (#'move/clojure-source-files dirs)]
     (update-file opts file replace-ns-symbol old-sym new-sym)))


s/map/pmap/

s/map/pmap/

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -86,7 +86,7 @@
 head of its parent. generate (above) 'decorates' each returned lightning bolt
 of this function with complements."
   (if (or (vector? spec) (seq? spec))
-    (reduce concat (map (fn [each-spec]
+    (reduce concat (pmap (fn [each-spec]
                            (lightning-bolt grammar lexicon each-spec depth index morph total-depth))
                          spec))
     (do
@@ -96,7 +96,7 @@
             parents (filter #(not (fail? %)) (map (fn [rule] (unifyc spec rule)) grammar))]
         (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
               (reduce concat
-                      (map (fn [parent]
+                      (pmap (fn [parent]
                               (if (= false (get-in parent [:head :phrasal] false))
                                 (let [candidate-lexemes (get-lex parent :head index spec)]
                                   (over/overh parent
@@ -104,7 +104,7 @@
                             parents))
               phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
               (if (< depth max-total-depth)
-                (reduce concat (map (fn [parent]
+                (reduce concat (pmap (fn [parent]
                                        (over/overh parent (lightning-bolt grammar lexicon (get-in parent [:head])
                                                                           (+ 1 depth) index morph (+ 1 total-depth))))
                                      parents)))]


whitespace

whitespace


improve logging

improve logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -143,7 +143,7 @@
                    :cat (get-in spec [:synsem :cat] :top)}
           :depth depth})

-        debug (log/debug (str "looking for key: "
+        debug (log/trace (str "looking for key: "
                              search-for-key))

         bolts ;; check for bolts compiled into model
@@ -152,12 +152,12 @@
     (cond
       (not (nil? bolts))
       (do
-        (log/debug (str "found compiled bolts."))
+        (log/trace (str "found compiled bolts."))
         (shufflefn (->> bolts
                         (map #(unify spec %))
                         (filter #(not (= :fail %))))))
       true
-      (do (log/debug (str "no compiled bolts found for: " search-for-key))
+      (do (log/trace (str "no compiled bolts found for: " search-for-key))
           (lazy-seq (lightning-bolts model spec 0 depth))))))

 (defn lightning-bolts
@@ -179,14 +179,25 @@
   ;; Each head child may be a leaf or
   ;; otherwise has a child with the same two options (leaf or a head child),
   ;; up to the maximum depth.
+  (log/debug (str "lightning-bolts: depth=" depth (if use-candidate-parents
+                                                    (str "; using ucp: " (count use-candidate-parents)))))
   (if (and (< depth max-depth)
            (not (= false (get-in spec [:phrasal] true))))
     (let [candidate-parents (or use-candidate-parents
                                 (->>
                                  (:grammar model)
-                                 (map #(unify % spec))
+                                 (map (fn [rule]
+                                        (let [result (unify rule spec)]
+                                          (if
+                                            (not (= :fail result))
+                                            (log/debug (str "rule:" (:rule rule)
+                                                            " => "
+                                                            "OK")))
+                                          result)))
                                  (filter #(not (= :fail %)))
                                  (shufflefn)))]
+      (log/debug (str "candidate-parents emptiness at depth:" depth ":"
+                      (empty? candidate-parents)))
       (if (not (empty? candidate-parents))
         (let [candidate-parent (first candidate-parents)]
           (lazy-cat
@@ -196,7 +207,11 @@
                                  max-depth)
                 (map (fn [head]
                        (assoc-in candidate-parent [:head] head))))
-           (lightning-bolts model spec depth max-depth (rest candidate-parents))))))
+           (lightning-bolts model spec depth max-depth (rest candidate-parents))))
+        (do
+          (log/debug (str "no rules found at depth: " depth " for spec: "
+                          (dag_unify.core/strip-refs spec)))
+          candidate-parents)))
     (shufflefn (get-lexemes model spec))))

 (defn add-comps-to-bolt


move do-assocs lower for clarity

move do-assocs lower for clarity

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -60,20 +60,7 @@
 ;;(def foo (map #(println (fo %)) (take 10000 (nugents med spec))))

 (declare add-bolt-at)
-
-;; TODO: use recur or reduce
-(defn do-assocs [accum paths val-at-paths model]
-  (if (empty? paths)
-    accum
-    (do-assocs
-     (let [result
-           (assoc-in accum
-                     (first paths)
-                     (first val-at-paths))]
-       (dissoc-paths result [(first paths)] model))
-     (rest paths)
-     (rest val-at-paths)
-     model)))
+(declare do-assoc)

 (defn filter-by [bolt-and-comps]
   (not (some empty? (vals bolt-and-comps))))
@@ -105,6 +92,20 @@
                                  model))
                     model))
                  all-of-them))))
+
+;; TODO: use recur or reduce
+(defn do-assocs [accum paths val-at-paths model]
+  (if (empty? paths)
+    accum
+    (do-assocs
+     (let [result
+           (assoc-in accum
+                     (first paths)
+                     (first val-at-paths))]
+       (dissoc-paths result [(first paths)] model))
+     (rest paths)
+     (rest val-at-paths)
+     model)))

 (declare comp-path-to-bolts)


Include require

Include require

--- src/exploud/aws.clj
+++ src/exploud/aws.clj
@@ -8,6 +8,7 @@
              [sqs :as sqs]]
             [cheshire.core :as json]
             [clojure.core.memoize :as memo]
+            [clojure.string :as str]
             [io.clj.logging :refer [with-logging-context]]
             [clojure.tools.logging :as log]
             [dire.core :refer [with-pre-hook!]]
@@ -132,7 +133,7 @@
   "Returns a json object describing the instances in the supplied environment
    with the given name and optional state (defaults to running)"
   [environment region name state]
-  (let [pattern-name (or (and (clojure.string/blank? name) "*")
+  (let [pattern-name (or (and (str/blank? name) "*")
                          (and (.contains name "*") name)
                          (str name "-*"))
         state (or state "running")


exit 1 on svn log error; diff -u0 -> -U 0

--- src/revdiff/core.clj
+++ src/revdiff/core.clj
@@ -39,7 +39,7 @@
         v (vpaths r1 r2 object object)
         o1 (first v)
         o2 (second v)
-        cmd-components ["svn" "diff" "--diff-cmd" "diff" "-x" "-u0" shhh o1 o2]]
+        cmd-components ["svn" "diff" "--diff-cmd" "diff" "-x" "-U 0" shhh o1 o2]]
     (if show (show-cmd cmd-components))
     (apply sh cmd-components)))

@@ -61,7 +61,8 @@
   (println "\nError retrieving repository information. Perhaps:\n")
   (println "- The supplied filename or URI is invalid, or")
   (println "- Your valid svn authentication credentials are not cached.")
-  (println))
+  (println)
+  (System/exit 1))

 ;; Return a newest-first sequence of revision numbers in which the object
 ;; changed.


don't need to call str here anymore

don't need to call str here anymore

--- src/clj/runbld/main.clj
+++ src/clj/runbld/main.clj
@@ -69,8 +69,8 @@
     (io/log "updating")
     (git/git-remote repo ["set-branches" "origin" branch])
     (let [fetch-args (concat (when depth
-                               ["--depth" (str depth)])
-                             ["origin" (str branch)])]
+                               ["--depth" depth])
+                             ["origin" branch])]
       (git/git-fetch repo fetch-args))
     (git/git-checkout repo branch)
     (git/git-pull repo)
@@ -94,8 +94,8 @@
         (let [clone-args (->> [(when (and reference
                                           (.exists (jio/as-file reference)))
                                  ["--reference" reference])
-                               (when branch ["--branch" (str branch)])
-                               (when depth ["--depth" (str depth)])]
+                               (when branch ["--branch" branch])
+                               (when depth ["--depth" depth])]
                               (filter identity)
                               (apply concat))]
           (io/log "cloning" remote)


Allow cwd to be overridden via config file

Closes #17

--- src/clj/runbld/opts.clj
+++ src/clj/runbld/opts.clj
@@ -3,15 +3,15 @@
             [schema.core :as s]
             [slingshot.slingshot :refer [throw+]])
   (:require [clj-yaml.core :as yaml]
-            [clojure.java.io :as io]
             [clojure.tools.cli :as cli]
             [environ.core :as environ]
             [runbld.store :as store]
             [runbld.util.data :refer [deep-merge-with deep-merge]]
             [runbld.util.date :as date]
+            [runbld.util.io :as io]
             [runbld.version :as version]))

-(def defaults
+(def config-file-defaults
   {:es
    {:url "http://localhost:9200"
     :build-index "build"
@@ -26,7 +26,8 @@
     :secret-key "secret"}

    :process
-   {:inherit-exit-code true}
+   {:inherit-exit-code true
+    :cwd (System/getProperty "user.dir")}

    :email
    {:host "localhost"
@@ -77,7 +78,7 @@
   [{:keys [job-name] :as opts} :- {(s/required-key :job-name) s/Str
                                    s/Keyword s/Any}]
   (deep-merge-with deep-merge
-                   defaults
+                   config-file-defaults
                    (if (environ/env :dev)
                      {}
                      (let [sys (system-config)]
@@ -103,8 +104,7 @@
 (def opts
   [["-v" "--version" "Print version"]
    ["-c" "--config FILE" "Config file"]
-   ["-d" "--cwd DIR" "Set CWD for the process"
-    :default (System/getProperty "user.dir")]
+   ["-d" "--cwd DIR" "Set CWD for the process"]
    ["-j" "--job-name JOBNAME" (str "Job name: org,project,branch,etc "
                                    "also read from $JOB_NAME")
     :default (environ/env :job-name)]
@@ -140,7 +140,7 @@
 (s/defn parse-args :- Opts
   [args :- [s/Str]]
   (let [{:keys [options arguments summary errors]
-         :as parsed-opts} (cli/parse-opts args opts)]
+         :as parsed-opts} (cli/parse-opts args opts :nodefault true)]

     (when (:help options)
       (throw+ {:help ::usage
@@ -169,9 +169,10 @@
                    (normalize options))]
       (merge options
              {:es (set-up-es (:es options))
-              :process (merge
-                        ;; Invariant: Jenkins passes it in through arguments
-                        {:scriptfile (first arguments)}
-                        (:process options))
+              :process (-> (:process options)
+                           ;; Invariant: Jenkins passes it in through arguments
+                           (assoc :scriptfile (first arguments))
+                           ;; Go ahead and resolve
+                           (update :cwd (comp str io/abspath-file)))
               :version {:string (version/version)
                         :hash (version/build)}}))))


Cleanup

Cleanup

--- src/cljs/ufo/views.cljs
+++ src/cljs/ufo/views.cljs
@@ -4,10 +4,9 @@
 (enable-console-print!)

 (defn thead [cols]
-  (fn []
-    [:tr
-     (map-indexed (fn [i v]
-                    [:th {:key i} (str v)]) cols)]))
+  [:tr
+   (map-indexed (fn [i v]
+                  [:th {:key i} (str v)]) cols)])

 (defn td [i v loading?]
   [:td (conj {:key (str "tr-" i "-" v)}
@@ -19,48 +18,35 @@
                            (re-frame/dispatch [:toggle v]))})
    v])

-(defn tbody []
-  (fn []
-    (let [loading? (re-frame/subscribe [:loading?])
-          emps (re-frame/subscribe [:emps])]
-      [:tbody
-       (doall
-        (map-indexed
-         (fn [i [id-val hm]]
-           [:tr {:key (str "tr-" i)}
-            (let [id (name id-val)
-                  salary-val (:salary hm)
-                  salary (if salary-val salary-val ;; auto-onclick
-                             (re-frame/dispatch [:id id]))
-                  abbrev-val (:abbrev hm)
-                  abbrev (if abbrev-val abbrev-val ;; auto-onclick
-                             (re-frame/dispatch [:id id]))]
-              (doall
-               (map #(td i % @loading?)
-                    (remove nil? [id salary abbrev]))))])
-         @emps))])))
-
 (defn table [id]
   (let [table-def (re-frame/subscribe [:tables])]
-    (fn []
-      [:div
-       [:div (->> @table-def id :name)]
-       [:table
-        [:thead [thead (->> @table-def id :cols)]]
-        [tbody]
-        ]])))
-
-(defn loading-throbber
-  []
-  (let [loading? (re-frame/subscribe [:loading?])]
-    (when @loading?
-      (do
-        #_(println "Loading...")
-        [:div.loading
-         [:div.three-quarters-loader "Loading..."]]))))
+    [:div
+     [:div (->> @table-def id :name)]
+     [:table
+      [:thead (thead (->> @table-def id :cols))]
+      [:tbody
+       (let [loading? (re-frame/subscribe [:loading?])]
+         (doall
+          (map-indexed
+           (fn [i [id-val hm]]
+             [:tr {:key (str "tr-" i)}
+              (let [id (name id-val)
+                    salary-val (:salary hm)
+                    salary (if salary-val salary-val ;; auto-onclick
+                               (re-frame/dispatch [:id id]))
+                    abbrev-val (:abbrev hm)
+                    abbrev (if abbrev-val abbrev-val ;; auto-onclick
+                               (re-frame/dispatch [:id id]))]
+                (doall
+                 (map #(td i % @loading?)
+                      (remove nil? [id salary abbrev]))))])
+           @(re-frame/subscribe [:emps]))))]
+      ]]))

 (defn main-panel []
   (fn []
     [:div
-     [loading-throbber]
-     [table :salaries]]))
+     (when @(re-frame/subscribe [:loading?])
+       [:div.loading
+        [:div.three-quarters-loader "Loading..."]])
+     (table :salaries)]))


Add uri-root command line option.

Add uri-root command line option.

--- src/incise/core.clj
+++ src/incise/core.clj
@@ -36,7 +36,8 @@
              ["-m" "--method" "serve, once, or deploy"
               :default :serve :parse-fn parse-method]
              ["-i" "--in-dir" "The directory to get source from"]
-             ["-o" "--out-dir" "The directory to put content into"])]
+             ["-o" "--out-dir" "The directory to put content into"]
+             ["-u" "--uri-root" "The path relative to the out-dir to actually root the site at"])]
     (conf/merge options)
     (if (:help options)
       (do (println banner)


Stop execution after pushing the data

Stop execution after pushing the data

--- src/kiries/core.clj
+++ src/kiries/core.clj
@@ -55,5 +55,5 @@

     (when (:data options)
       (println "Pushing test data")
-      (dp/push-data (:total options)))
-    ))
+      (dp/push-data (:total options))
+      (System/exit 0))))


add errors to report

add errors to report

--- src/shuppet/core.clj
+++ src/shuppet/core.clj
@@ -135,18 +135,28 @@
     (doall
      (pmap (fn [app-name]
              (try+
-              (*apply-config environment app-name)
+              {:app app-name
+               :report (*apply-config environment app-name)}
               (catch [:type :shuppet.git/git] {:keys [message]}
-                (warn message))
+                (warn message)
+                {:app app-name
+                 :error message})
               (catch  [:type :shuppet.core-shuppet/invalid-config] {:keys [message]}
                 (cf/error {:environment environment
                            :title "error while loading config"
                            :app-name app-name
                            :message message })
-                (error (str app-name " config in " environment " cannot be loaded: " message)))
-
+                (error (str app-name " config in " environment " cannot be loaded: " message))
+                {:app app-name
+                 :error message})
+              (catch Object e
+                (error "unexpected error: " &throw-context)
+                {:app app-name
+                 :error (:object e)})
               (catch Exception e
-                (error (str app-name " in " environment " failed: " (util/str-stacktrace e))))))
+                (error (str app-name " in " environment " failed: " (util/str-stacktrace e)))
+                {:app app-name
+                 :error (util/str-stacktrace e)})))
            names))))

 (defn update-configs


Remove display loop. Calls to display are now synchronous.

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -1,6 +1,6 @@
 (ns sparkle.core
   (:require [clojure.core.async :refer [thread chan <!! >!! alt!! close!]]
-   [clojure.algo.generic.functor :refer [fmap]]
+            [clojure.algo.generic.functor :refer [fmap]]
             [com.stuartsierra.component :as component])
   (:gen-class))

@@ -50,34 +50,19 @@
   "A protocol for things that are capable of displaying frames"
   (display [displayer frame] "Display a frame"))

-(defn to-displayer [{:keys [frame-chan] :as displayer} frame]
-  (>!! frame-chan frame))

-(defn start-displayer [{:keys [frame-chan] :as displayer}]
-  (thread
-    (loop []
-      (let [frame (<!! frame-chan)]
-        (if frame
-          (do (display displayer frame)
-              (recur))
-          (println "Shutting down displayer"))))))
-
-;; The minimum time between frames printed by ConsoleDisplayer
+;; The minimum time, in millis, between frames printed by ConsoleDisplayer
 (def console-display-interval 500)

-(defrecord ConsoleDisplayer [frame-chan previous]
+(defrecord ConsoleDisplayer [previous]
   component/Lifecycle
   (start [displayer]
-    (let [displayer (-> displayer
-                        (assoc :frame-chan (chan))
-                        (assoc :previous (atom {:frame nil
-                                                :time (- (now) console-display-interval)})))]
-      (start-displayer displayer)
-      displayer))
+    (assoc displayer
+           :previous (atom {:frame nil
+                            :time (- (now) console-display-interval)})))

   (stop [displayer]
-    (close! frame-chan)
-    displayer)
+    (dissoc displayer :previous))

   Displayer
   (display [{:keys [previous]} frame]
@@ -124,7 +109,7 @@
             (if (= status :running)
               (alt!! command-chan ([command] (execute command state status))
                      :default (let [next-frame (render-step state)]
-                                (to-displayer displayer next-frame)
+                                (display displayer next-frame)
                                 [state :running]))
               (execute (<!! command-chan) state status))]
         (if loop-result


better resolution of implicit type handlers

--- src/latte/utils.clj
+++ src/latte/utils.clj
@@ -127,10 +127,24 @@

 (defonce +implicit-type-parameters-handlers+ (atom {}))

+(defn fully-qualified-symbol
+  ([sym] (fully-qualified-symbol *ns* sym))
+  ([ns sym] (symbol (str (ns-name ns) "/" sym))))
+
+;; (fully-qualified-symbol 'test)
+;; => latte.utils/test
+
+;; (fully-qualified-symbol (the-ns 'latte-kernel.norm) 'test)
+;; => latte-kernel.norm/test
+
 (defn register-implicit-type-parameters-handler!
   [keysym handler-fn arity]
-  (swap! +implicit-type-parameters-handlers+ (fn [old] (assoc old keysym [handler-fn arity]))))
-
+  (swap! +implicit-type-parameters-handlers+
+         (fn [old] (assoc old
+                          (or (resolve keysym)
+                              keysym) [handler-fn arity]
+                          ;; (fully-qualified-symbol keysym) [handler-fn arity]
+                          ))))

 (defn fetch-atomic-implicit-type-parameter
   [def-env ctx ty]
@@ -154,7 +168,9 @@
      (if-let [[handler-fn arity]
             (and (sequential? param-ty)
                  (>= (count param-ty) 1)
-                 (get handlers (first param-ty)))]
+                 (let [search-key (or (resolve (first param-ty))
+                                      (first param-ty))]
+                   (get handlers search-key)))]
      ;; we have a handler
      (let [[implicit-types' lt-params]
            (reduce (fn [[itypes ltparams] param]


don't use a var for ws-msg defmulti

don't use a var for ws-msg defmulti

--- src/dato/lib/server.clj
+++ src/dato/lib/server.clj
@@ -120,8 +120,7 @@
                    (casync/untap tx-mult tx-ch)))))
     stop-ch))

-(defn handle-websocket-msg-dispatch [tal-state dato-config session-store msg] (:op msg))
-(defmulti handle-websocket-msg #'handle-websocket-msg-dispatch)
+(defmulti handle-websocket-msg (fn [tal-state dato-config session-store msg] (:op msg)))

 (defmethod handle-websocket-msg :default
   [tal-state dato-config session-store msg]


Fix bad syntax

Fix bad syntax

--- src/devtools/debug.cljs
+++ src/devtools/debug.cljs
@@ -53,7 +53,7 @@
   (try
     (log (logger name) (str args))                          ; potential exception converting args to string
     (catch :default e
-      log-exception (str e)))
+      (log-exception (str e))))
   (indent!)
   (let [api-response (apply api-call args)
         api-response-filter (fn [key value] (if (= key "object") "##REF##" value))]
@@ -79,7 +79,7 @@
                              (try
                                (log (logger "console") (str args)) ; potential exception converting args to string
                                (catch :default e
-                                 log-exception (str e)))
+                                 (log-exception (str e))))
                              (.apply original-log-fn js/console (into-array args))))))

 (defn init! []


add player selection highlight, remove cruft

--- src/dodgeball/core.cljs
+++ src/dodgeball/core.cljs
@@ -27,9 +27,6 @@

 (def board-size (range 0 9))
 (def bench-size 4)
-(def opponent-image "images/front-noball.gif")
-(def player-image "images/back-noball.gif")
-(def ball-image "images/ball.gif")

 (defn border-top [y]
   (cond
@@ -47,11 +44,8 @@
                  (= (:y position) (:y %)))
                (:cells (om/root-cursor app-state)))))

-
-(defn highlight-tile [e unit]
-  (let [cursor (om/ref-cursor (:selected-unit (om/root-cursor app-state)))]
-    (om/update! cursor unit))
-    (set! (-> e .-target .-parentElement .-style .-border) "2px solid #f00"))
+(defn highlight-tile [e]
+ (set! (.. e -target -style -background) "gray"))

 (defn update-piece-position [e state]
   (om/transact! (om/root-cursor app-state) :cells #(conj {:type :my-team :x 1 :y 8})))
@@ -60,17 +54,13 @@
   (reify
     om/IRenderState
     (render-state [this {:keys [move]}]
-      (println cursor)
-      (dom/div #js {:className "red-team"}))))
+      (dom/div #js {:onClick #(highlight-tile %) :className "red-team"}))))

 (defn opponent-view [cursor owner]
   (reify
     om/IRender
     (render [_]
       (dom/div #js {:className "blue-team"}))))
-
-(defn handle-move [e position]
-  (put! (:move position) position))

 (defn tile-view [cursor owner]
   (reify
@@ -85,7 +75,6 @@
                (om/build opponent-view cursor)
             (= (:type found) :loose-ball)
                (om/build ball-view cursor)))))))
-

 (defn ball-view [cursor owner]
   (reify
@@ -112,8 +101,7 @@
                            #(if (= player-to-move %)
                                   (assoc % :x x :y y)
                                   %)
-                         cs)))))
-              (println (:cells app))))
+                         cs)))))))
             (recur)))))
     om/IRenderState
     (render-state [this {:keys [move]}]


I want them to see what they destroy

I want them to see what they destroy

--- src/game/main_game.cljs
+++ src/game/main_game.cljs
@@ -19,9 +19,9 @@

         ;; Populate world
         (.. game -add (sprite 0 0 "world"))
-        (set! (.. this -player) (.. game -add (sprite 600 1000 "player")))
         (set! (.. this -weaponSprite) (.. game -add (sprite 598 80 "weapon")))
         (.. this -weaponSprite -anchor (setTo 0.5 0.5))
+        (set! (.. this -player) (.. game -add (sprite 600 1000 "player")))

         ;; Glasses

@@ -113,13 +113,14 @@
             (when (.. this -action -isDown)
               (set! (.. this -weapon) true)
               (.. this -weaponSprite destroy)
-              (.. this -player (loadTexture "playerHammer" 0))
+              #_(.. this -player (loadTexture "playerHammer" 0))
               (.. this (triggerDialogue :hammer)))
             ))

         ;; If possible, offer to break glass
         (when (and (.. this -weapon)
-                   (.. this -currentGlass))
+                   (.. this -currentGlass)
+                   (seq (.. this -dialogue)))
           (do
             ;;TODO text to offer to break the glass
             (when (.. this -action -isDown)


Query to obtain the nodes that need crawling

--- src/tropefest/db.clj
+++ src/tropefest/db.clj
@@ -58,6 +58,19 @@
       (-> (match "v")
           (select-keys [:data :metadata])))))

+(defn query-nodes-to-crawl
+  [conn]
+  (let [now (.getMillis (j/date-time))
+        matches (cy/tquery conn "MATCH (v) WHERE v.nextupdate < {now} RETURN v" {:now now})]
+    (if (empty? matches)
+      matches
+      (->> matches
+           (map #(% "v"))
+           (map #(select-keys % [:data :metadata])))
+      )))
+
+
+
 (defn create-node
   "Creates a node from a connection with a label"
   [conn label data-items]


fixed

fixed

--- src/wiki/db/core.clj
+++ src/wiki/db/core.clj
@@ -55,10 +55,10 @@
 (defn update-modified-time [article-id]
   (j/update! mysql-db :articles {:modified_time (current-time)} ["id = ?" article-id]))

-(defn update-article [article-id content]
+(defn update-article [user article-id content]
   (j/with-db-transaction [t-con mysql-db]
     (do
-      (update-content article-id content)
+      (update-content article-id content user)
       (update-modified-time article-id)
       (increment-edits article-id))))


Add ansi-codes for bright fg and bg colors

--- src/zprint/ansi.cljc
+++ src/zprint/ansi.cljc
@@ -32,7 +32,25 @@
    :back-magenta 45,
    :back-purple 45,
    :back-cyan 46,
-   :back-white 47})
+   :back-white 47,
+   :bright-black 90,
+   :bright-red 91,
+   :bright-green 92,
+   :bright-yellow 93,
+   :bright-blue 94,
+   :bright-magenta 95,
+   :bright-purple 95,
+   :bright-cyan 96,
+   :bright-white 97,
+   :back-bright-black 100,
+   :back-bright-red 101,
+   :back-bright-green 102,
+   :back-bright-yellow 103,
+   :back-bright-blue 104,
+   :back-bright-magenta 105,
+   :back-bright-purple 105,
+   :back-bright-cyan 106,
+   :back-bright-white 107})

 (defn color-str
   "Wraps a string with ANSI escape codes."


Fix resources_resource last-modified (#281)

* Fix resources_resource for non-jar/file classpaths

There are other kinds of resource that can be returned via io/resource,
for example with pack you may get a "onejar" protocol.  Fortunately,
URLs provide a generic solution for getting their last modified time.

* Handle nil in resources_resource

Some resources may not be able to return their modified time, when this
is true they return 0.

--- src/yada/resources/resources_resource.clj
+++ src/yada/resources/resources_resource.clj
@@ -9,18 +9,18 @@

 (defn new-resources-resource
   [root-path]
-  (letfn [(file-of-resource [^java.net.URL res]
-            (case (.getProtocol res)
-              "jar" (let [^java.net.JarURLConnection conn (.openConnection res)
-                          jar-file-url ^java.net.URL (.getJarFileURL conn)]
-                      (.getFile jar-file-url))
-              "file" (.getFile res)))]
+  (letfn [(last-modified [^java.net.URL res]
+            (with-open [conn (.openConnection res)]
+              (let [lm (.getLastModified conn)]
+                (when-not (zero? lm) lm))))]
     (resource
      {:path-info? true
       :properties
       (fn [ctx]
-        (if-let [res (io/resource (str root-path (-> ctx :request :path-info)))]
-          {:last-modified (some-> res file-of-resource io/file (.lastModified))}
+        (if-let [lm (some-> (io/resource (str root-path
+                                              (-> ctx :request :path-info)))
+                            (last-modified))]
+          {:last-modified lm}
           {}))
       :methods
       {:get


Increase chance of generating without errors

--- test/com/wsscode/pathom/core_gen_test.clj
+++ test/com/wsscode/pathom/core_gen_test.clj
@@ -74,7 +74,8 @@
                                                ::s.query/gen-params
                                                (fn [_] (gen/map gen/keyword gen/simple-type-printable {:max-elements 3}))}
                               ::s.query/gen-query)
-              throw-errors? gen/boolean
+              throw-errors? (gen/frequency [[8 (gen/return false)]
+                                            [1 (gen/return true)]])
               plugins       gen-plugins]
       {:query   query
        :errors? throw-errors?
@@ -141,7 +142,8 @@

   (gen/generate (base-gen) 18)

-  (tc/quick-check 500 (handle-matches) :max-size 18)
+  (time
+    (tc/quick-check 300 (handle-matches) :max-size 18))

   (let [env   (assoc parser-env ::pt/throw-errors? true)
         query '[(+- {})]


Turn on validation during main run

Turn on validation during main run

--- src/runbld/main.clj
+++ src/runbld/main.clj
@@ -7,6 +7,7 @@
             [runbld.opts :as opts]
             [runbld.process :as proc]
             [runbld.publish :as publish]
+            [schema.core :as s]
             [slingshot.slingshot :refer [try+ throw+]]))

 (defn really-die
@@ -48,7 +49,8 @@
   (try+
    (let [opts (opts/parse-args args)
          _ (log ">>>>>>>>>>>> SCRIPT EXECUTION BEGIN >>>>>>>>>>>>")
-         {:keys [errors] :as res} (run opts)
+         {:keys [errors] :as res} (s/with-fn-validation
+                                    (run opts))
          {:keys [took status]} (:process res)
          _ (log "<<<<<<<<<<<< SCRIPT EXECUTION END   <<<<<<<<<<<<")]
      (log (format "DURATION: %sms" took))


Require onyx.peer.function by default.

Require onyx.peer.function by default.

--- src/onyx/system.clj
+++ src/onyx/system.clj
@@ -13,6 +13,7 @@
             [onyx.peer.peer-group-manager :as pgm]
             [onyx.monitoring.no-op-monitoring]
             [onyx.monitoring.custom-monitoring]
+            [onyx.peer.function]
             [onyx.log.zookeeper :refer [zookeeper]]
             [onyx.query :as qs]
             [onyx.static.validation :as validator]