rework Djinn, Leprechaun, Scheherazade to check for uniqueness

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -162,16 +162,20 @@
                                                     (:deck runner)) :sorted))
                  :cost [:click 1 :credit 1] :effect (effect (move target :hand) (shuffle! :deck))}
                 {:label "Install a non-Icebreaker program on Djinn"
-                 :cost [:click 1]
-                 :prompt "Choose a non-Icebreaker program in your Grip to install on Djinn"
-                 :choices {:req #(and (is-type? % "Program")
-                                      (not (has-subtype? % "Icebreaker"))
-                                      (in-hand? %))}
-                 :msg (msg "install and host " (:title target))
-                 :effect (effect (gain :memory (:memoryunits target))
-                                 (runner-install target {:host-card card})
-                                 (update! (assoc (get-card state card)
-                                                 :hosted-programs (cons (:cid target) (:hosted-programs card)))))}
+                 :effect (effect (resolve-ability
+                                   {:cost [:click 1]
+                                    :prompt "Choose a non-Icebreaker program in your Grip to install on Djinn"
+                                    :choices {:req #(and (is-type? % "Program")
+                                                         (runner-can-install? state side % false)
+                                                         (not (has-subtype? % "Icebreaker"))
+                                                         (in-hand? %))}
+                                    :msg (msg "install and host " (:title target))
+                                    :effect (effect (gain :memory (:memoryunits target))
+                                                    (runner-install target {:host-card card})
+                                                    (update! (assoc (get-card state card)
+                                                                    :hosted-programs
+                                                                    (cons (:cid target) (:hosted-programs card)))))}
+                                  card nil))}
                 {:label "Host an installed non-Icebreaker program on Djinn"
                  :prompt "Choose an installed non-Icebreaker program to host on Djinn"
                  :choices {:req #(and (is-type? % "Program")
@@ -318,15 +322,19 @@
    "Leprechaun"
    {:abilities [{:label "Install a program on Leprechaun"
                  :req (req (< (count (:hosted card)) 2))
-                 :cost [:click 1]
-                 :prompt "Choose a program in your Grip to install on Leprechaun"
-                 :choices {:req #(and (is-type? % "Program")
-                                      (in-hand? %))}
-                 :msg (msg "host " (:title target))
-                 :effect (effect (gain :memory (:memoryunits target))
-                                 (runner-install target {:host-card card})
-                                 (update! (assoc (get-card state card)
-                                                 :hosted-programs (cons (:cid target) (:hosted-programs card)))))}
+                 :effect (effect (resolve-ability
+                                   {:cost [:click 1]
+                                    :prompt "Choose a program in your Grip to install on Leprechaun"
+                                    :choices {:req #(and (is-type? % "Program")
+                                                         (runner-can-install? state side % false)
+                                                         (in-hand? %))}
+                                    :msg (msg "host " (:title target))
+                                    :effect (effect (gain :memory (:memoryunits target))
+                                                    (runner-install target {:host-card card})
+                                                    (update! (assoc (get-card state card)
+                                                                    :hosted-programs
+                                                                    (cons (:cid target) (:hosted-programs card)))))}
+                                  card nil))}
                 {:label "Host an installed program on Leprechaun"
                  :req (req (< (count (:hosted card)) 2))
                  :prompt "Choose an installed program to host on Leprechaun"
@@ -566,12 +574,15 @@

    "Scheherazade"
    {:abilities [{:label "Install and host a program from Grip"
-                 :cost [:click 1]
-                 :prompt "Choose a program to install on Scheherazade from your grip"
-                 :choices {:req #(and (is-type? % "Program")
-                                      (in-hand? %))}
-                 :msg (msg "host " (:title target) " and gain 1 [Credits]")
-                 :effect (effect (runner-install target {:host-card card}) (gain :credit 1))}
+                 :effect (effect (resolve-ability
+                                   {:cost [:click 1]
+                                    :prompt "Choose a program to install on Scheherazade from your grip"
+                                    :choices {:req #(and (is-type? % "Program")
+                                                         (runner-can-install? state side % false)
+                                                         (in-hand? %))}
+                                    :msg (msg "host " (:title target) " and gain 1 [Credits]")
+                                    :effect (effect (runner-install target {:host-card card}) (gain :credit 1))}
+                                  card nil))}
                 {:label "Host an installed program"
                  :prompt "Choose a program to host on Scheherazade"
                  :choices {:req #(and (is-type? % "Program")


Some minor cleanups to main.cljs

Some minor cleanups to main.cljs

--- src/cljs/comic_reader/main.cljs
+++ src/cljs/comic_reader/main.cljs
@@ -54,8 +54,7 @@
      (-> db
          (set-page-key :reader)))))

-(defn main-panel
-  [page-key]
+(defn main-panel [page-key]
   (case page-key
     :site-list [site-list/site-list-container]
     :comic-list [comic-list/comic-page-container]
@@ -65,11 +64,9 @@

 (defn main-panel-container []
   (let [page-key (re-frame/subscribe [:page-key])]
-    (fn []
-      [main-panel (deref page-key)])))
+    [#'main-panel @page-key]))

-(defn ^:export main
-  []
+(defn ^:export main []
   (enable-console-print!)
   (setup!)
   (site-list/setup!)
@@ -77,5 +74,3 @@
   (re-frame/dispatch [:view-sites])
   (reagent/render-component [main-panel-container]
                             (.getElementById js/document "app")))
-
-(main)


No-doc Aeron peer manager

No-doc Aeron peer manager

--- src/onyx/messaging/aeron/peer_manager.clj
+++ src/onyx/messaging/aeron/peer_manager.clj
@@ -1,4 +1,4 @@
-(ns onyx.messaging.aeron.peer-manager
+(ns ^:no-doc onyx.messaging.aeron.peer-manager
   "Fast way for peer group subscribers to multiplex via a short id to peer channels. "
   (:refer-clojure :exclude [assoc dissoc])
   (:require [taoensso.timbre :refer [fatal info] :as timbre])


remove sentry test stuff

remove sentry test stuff

--- src/open_company/api/companies.clj
+++ src/open_company/api/companies.clj
@@ -4,10 +4,7 @@
             [liberator.core :refer (defresource by-method)]
             [open-company.api.common :as common]
             [open-company.resources.company :as company]
-            [open-company.representations.company :as company-rep]
-            [open-company.config :as c]
-            [cheshire.core :as json]
-            [raven-clj.core :as raven]))
+            [open-company.representations.company :as company-rep]))

 (defun add-ticker
   "Add the ticker symbol to the company properties if it's missing."
@@ -77,28 +74,9 @@
   :exists? (fn [_] {:companies (company/list-companies)})
   :handle-ok (fn [ctx] (company-rep/render-company-list (:companies ctx))))

-(defresource sentry []
-  :available-charsets [common/UTF8]
-  :available-media-types [company-rep/collection-media-type]
-  :handle-not-acceptable (common/only-accept 406 company-rep/collection-media-type)
-  :allowed-methods [:get]
-
-  ;; Get a list of companies
-  :exists? (fn [_] {:sentry c/dsn})
-  :handle-ok (fn [ctx]
-                (let [sentry-resp (raven/capture (:sentry ctx) {
-                                :message "Bago test test"
-                                :tags {:version "0.0.1"}
-                                :logger "main-logger"
-                                :extra {
-                                  :my-key 1
-                                  :some-other-value "foo bar"}})]
-                  (json/generate-string {:collection (array-map :sentry (:sentry ctx) :resp sentry-resp)} {:pretty true}))))
-
 ;; ----- Routes -----

 (defroutes company-routes
   (ANY "/v1/companies/:ticker" [ticker] (company ticker))
   (GET "/v1/companies/" [] (company-list))
-  (GET "/v1/companies" [] (company-list))
-  (GET "/v1/sentry" [] (sentry)))+  (GET "/v1/companies" [] (company-list)))


Tabs in GUI now get numbered

Tabs in GUI now get numbered

and also a lost call to «add-action-listener» has been replaced with
«with-action-on».

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

--- src/conexp/contrib/gui/util.clj
+++ src/conexp/contrib/gui/util.clj
@@ -392,8 +392,7 @@
                              (when (instance? AbstractButton component)
                                (.setBorderPainted ^AbstractButton component false)))))]
     (doto tabbutton
-      (add-action-listener (fn [evt]
-                             (.remove tabpane (.indexOfComponent tabpane component))))
+      (with-action-on (.remove tabpane (.indexOfComponent tabpane component)))
       (.addMouseListener mouse-listener)
       (.setPreferredSize (Dimension. 17 17))
       (.setToolTipText "Close this tab")
@@ -419,11 +418,14 @@

 (defn add-tab
   "Addes given panel to the tabpane of frame with given title, if given."
-  ([^JFrame frame, ^JPanel pane, title]
+  ([^JFrame frame, ^JPanel pane, ^String title]
      (do-swing
       (let [^JTabbedPane tabpane (get-tabpane frame)]
         (.add tabpane pane)
-        (let [index (.indexOfComponent tabpane pane)]
+        (let [index (.indexOfComponent tabpane pane),
+              title (if-not (.isEmpty title)
+                      (str index " (" title ")")
+                      (str index))]
           (.setTabComponentAt tabpane index (make-tab-head tabpane pane title))
           (.setTitleAt tabpane index title)
           (.setSelectedIndex tabpane index)))


(MAINT) Fix reflection warnings

(MAINT) Fix reflection warnings

--- src/puppetlabs/config/typesafe.clj
+++ src/puppetlabs/config/typesafe.clj
@@ -13,7 +13,7 @@
 (defn strip-quotes
   "Given a string read from a config file, check to see if it begins and ends with
   double-quotes, and if so, remove them."
-  [s]
+  [^String s]
   {:pre [(string? s)]
    :post [(string? %)
           (not (and (.startsWith % "\"")
@@ -46,7 +46,7 @@
 (defn nested-java-map->map
   "Given a (potentially nested) java Map object read from a config file,
   convert it (potentially recursively) to a clojure map with keywordized keys."
-  [m]
+  [^Map m]
   {:pre [(instance? Map m)]
    :post [(map? %)
           (every? keyword? (keys %))]}
@@ -78,7 +78,7 @@

 (defn config->map
   "Converts an instance of `Config` to a more user-friendly clojure map"
-  [config]
+  [^Config config]
   {:pre [(instance? Config config)]
    :post [(map? %)]}
   (-> config


https

https

--- src/ru/profitware/tpg_web/core.clj
+++ src/ru/profitware/tpg_web/core.clj
@@ -16,7 +16,7 @@
   "home")

 (def static-root
-  "http://theprofitwaregroup.github.io/tpg_su_cdn/default/")
+  "https://theprofitwaregroup.github.io/tpg_su_cdn/default/")

 (defn- render-map-by-current-map
   [current-map]


Add a function to convert an image to grayscale

--- src/fivetonine/collage/core.clj
+++ src/fivetonine/collage/core.clj
@@ -19,7 +19,9 @@
 ;;
 (ns fivetonine.collage.core
   (:require [fivetonine.collage.util :as util])
+  (:import java.awt.color.ColorSpace)
   (:import java.awt.image.BufferedImage)
+  (:import java.awt.image.ColorConvertOp)
   (:import java.awt.geom.AffineTransform)
   (:import java.awt.AlphaComposite)
   (:import java.awt.Color)
@@ -271,6 +273,14 @@
       .dispose)
     triangle))

+(defn grayscale
+  "Convert an image to grayscale."
+  [^BufferedImage image]
+  (let [output (BufferedImage. (.getWidth image) (.getHeight image) (.getType image))]
+    (-> (ColorConvertOp. (.. image getColorModel getColorSpace) (ColorSpace/getInstance ColorSpace/CS_GRAY) nil)
+        (.filter image output))
+    output))
+
 (defmacro with-image
   "A helper for applying multiple operations to an image.


♻ Refactor territory-bro.congregation/projection to be a multimethod

Why:
- Automatically ignores non-congregation events
- Unifies with other namespaces

--- src/territory_bro/congregation.clj
+++ src/territory_bro/congregation.clj
@@ -11,67 +11,51 @@

 ;;;; Read model

-(defmulti ^:private update-congregation (fn [_congregation event]
-                                          (:event/type event)))
+(defmulti projection (fn [_state event]
+                       (:event/type event)))

-(defmethod update-congregation :default [congregation _event]
-  congregation)
-
-(defmethod update-congregation :congregation.event/congregation-created
-  [congregation event]
-  (-> congregation
-      (assoc :congregation/id (:congregation/id event))
-      (assoc :congregation/name (:congregation/name event))
-      (assoc :congregation/schema-name (:congregation/schema-name event))))
-
-(defmethod update-congregation :congregation.event/congregation-renamed
-  [congregation event]
-  (-> congregation
-      (assoc :congregation/name (:congregation/name event))))
-
-(defmethod update-congregation :congregation.event/permission-granted
-  [congregation event]
-  (-> congregation
-      (update-in [:congregation/user-permissions (:user/id event)]
-                 conj-set
-                 (:permission/id event))))
-
-(defmethod update-congregation :congregation.event/permission-revoked
-  [congregation event]
-  (-> congregation
-      ;; TODO: remove user when no more permissions remain
-      (update-in [:congregation/user-permissions (:user/id event)]
-                 disj
-                 (:permission/id event))))
-
-
-(defmulti ^:private update-permissions (fn [_state event]
-                                         (:event/type event)))
-
-(defmethod update-permissions :default [state _event]
+(defmethod projection :default [state _event]
   state)

-(defmethod update-permissions :congregation.event/permission-granted
+(defn- update-cong [state event f]
+  (update-in state [::congregations (:congregation/id event)] f))
+
+(defmethod projection :congregation.event/congregation-created
   [state event]
   (-> state
+      (update-cong event (fn [congregation]
+                           (-> congregation
+                               (assoc :congregation/id (:congregation/id event))
+                               (assoc :congregation/name (:congregation/name event))
+                               (assoc :congregation/schema-name (:congregation/schema-name event)))))))
+
+(defmethod projection :congregation.event/congregation-renamed
+  [state event]
+  (-> state
+      (update-cong event (fn [congregation]
+                           (-> congregation
+                               (assoc :congregation/name (:congregation/name event)))))))
+
+(defmethod projection :congregation.event/permission-granted
+  [state event]
+  (-> state
+      (update-cong event (fn [congregation]
+                           (-> congregation
+                               (update-in [:congregation/user-permissions (:user/id event)]
+                                          conj-set (:permission/id event)))))
       (permissions/grant (:user/id event) [(:permission/id event)
                                            (:congregation/id event)])))

-(defmethod update-permissions :congregation.event/permission-revoked
+(defmethod projection :congregation.event/permission-revoked
   [state event]
   (-> state
+      (update-cong event (fn [congregation]
+                           (-> congregation
+                               ;; TODO: remove user when no more permissions remain
+                               (update-in [:congregation/user-permissions (:user/id event)]
+                                          disj (:permission/id event)))))
       (permissions/revoke (:user/id event) [(:permission/id event)
                                             (:congregation/id event)])))
-
-
-(defn projection [state event]
-  ;; XXX: this assert will fail once we start having non-congregation specific events
-  ;; TODO: change projection to be the multimethod instead of update-congregation
-  (assert (some? (:congregation/id event))
-          {:event event})
-  (-> state
-      (update-in [::congregations (:congregation/id event)] update-congregation event)
-      (update-permissions event)))

 (defn sudo [state user-id]
   (-> state
@@ -109,8 +93,9 @@

 ;;;; Write model

-(defn- write-model [events]
-  (reduce update-congregation nil events))
+(defn- write-model [command events]
+  (let [state (reduce projection nil events)]
+    (get-in state [::congregations (:congregation/id command)])))

 ;;;; Command handlers
@@ -197,7 +182,7 @@
         :congregation/name new-name}])))

 (defn handle-command [command events injections]
-  (command-handler command (write-model events) injections))
+  (command-handler command (write-model command events) injections))

 ;;;; User access


syntactic sugar around batched inserts

syntactic sugar around batched inserts

--- src/main/java/org/dada/core.clj
+++ src/main/java/org/dada/core.clj
@@ -16,6 +16,9 @@

 (defn insert [#^View view item]
   (.update view (list (Update. nil item)) '() '()))
+
+(defn insert-n [#^View view items]
+  (.update view (map (fn [item] (Update. nil item)) items) '() '()))

 (defn update [#^View view oldValue newValue]
   (.update view '() (list (Update. oldValue newValue)) '()))


Fixed bug where server would not start

Fixed bug where server would not start

I deleted the code I made in the last commit to fix it :(

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -632,26 +632,31 @@

         existing-query     (get @cached-queries   query)

-        clients            @(:clients @existing-query)
         ]
     (do
       (println (str "    " ))
       (println (str "    update-query-in-cache" ))
       (println (str "    " query))
-      (println (str "    clients: " clients))
-      (do (for [client clients]
-        (println (str "    Client: " client))
-        ))

       (if (not existing-query)
         (swap! cached-queries assoc  query (atom {:clients  (atom #{})})))

+
       (let [the-query        (get @cached-queries   query)
+            ;clients         @(:clients @existing-query)
             ]
         (swap! the-query assoc  :records       result-id-vector)
         (swap! the-query assoc  :count         record-count)
         (swap! the-query assoc  :timestamp    (quot (System/currentTimeMillis) 1000))
+
+
+        ;(println (str "    clients: " clients))
+        (comment do (for [client clients]
+              (println (str "    Client: " client))
+              ))
+
+
         ))))


Add shuffle command; fix devth/yetibot#375

--- src/yetibot/core/commands/collections.clj
+++ src/yetibot/core/commands/collections.clj
@@ -19,6 +19,15 @@

 (cmd-hook #"random"
           _ random)
+
+; shuffle
+(defn shuffle-cmd
+  "shuffle <list>"
+  [{items :opts}]
+  (shuffle (ensure-items-collection items)))
+
+(cmd-hook #"shuffle"
+          _ shuffle-cmd)

 (def head-tail-regex #"(\d+).+")


z-index is important

z-index is important

--- support/src/figwheel/client/heads_up.cljs
+++ support/src/figwheel/client/heads_up.cljs
@@ -75,6 +75,7 @@
                                 "height: 0px;"
                                 "opacity: 0.0;"
                                 "box-sizing: border-box;"
+                                "z-index: 10000;"
                                 ) })]
         (set! (.-onclick el) heads-up-onclick-handler)
         (set! (.-innerHTML el) (str clojure-symbol-svg))


Renamed welcome phrase on homepage

Renamed welcome phrase on homepage

--- src/versioned/controllers/home.clj
+++ src/versioned/controllers/home.clj
@@ -3,4 +3,4 @@
 (defn index [app request]
   {:status 200
    :headers {"Content-Type" "text/html"}
-   :body "Welcome to Content API"})
+   :body "Welcome to the Versioned API"})


More type hints

More type hints

--- src/obb_rules/actions/goto.cljc
+++ src/obb_rules/actions/goto.cljc
@@ -11,7 +11,7 @@

 (defn- distance-to
   "Calculates the distance between two coordinates"
-  [[xa ya] [xb yb]]
+  [[^Integer xa ^Integer ya] [^Integer xb ^Integer yb]]
   (math/sqrt
     (+
       (math/expt (- xa xb) 2)


Fix if statement to only print Twilio config warning if Twilio's not configured

--- src/deadman/core.clj
+++ src/deadman/core.clj
@@ -22,8 +22,8 @@
     (let [client (new TwilioRestClient twilio-sid twilio-auth-token)
           message-factory (.getSmsFactory (.getAccount client))
           message-params {"Body" message "To" number "From" twilio-from-number}]
-      (.create message-factory message-params)))
-    (prn "Twilio not configured"))
+      (.create message-factory message-params))
+    (prn "Twilio not configured")))

 (defn build-timer-thread [{timeout "timeout", number "number", message "message", :as timer-data}]
   (Thread.


Add alternatives flags

Add alternatives flags

--- src/degasolv/cli.clj
+++ src/degasolv/cli.clj
@@ -125,7 +125,8 @@
   resolve-locations!
   [options arguments]
   (let
-      [{:keys [repositories
+      [{:keys [alternatives
+               repositories
                resolve-strat
                conflict-strat
                index-strat
@@ -183,7 +184,8 @@
         :present-packages present-packages
         :strategy (keyword resolve-strat)
         :conflict-strat (keyword conflict-strat)
-        :compare cmp)]
+        :compare cmp
+        :allow-alternatives alternatives)]
     (case
       (first result)
       :successful
@@ -302,7 +304,15 @@
     :function resolve-locations!
     :required-arguments {:repositories ["-R" "--repository"]
                          :requirements ["-r" "--requirement"]}
-    :cli [["-f" "--conflict-strat STRAT"
+    :cli [
+          ["-a" "--enable-alternatives" "Consider all alternatives"
+           :id :alternatives
+           :default true
+           :assoc-fn (fn [m k v] (assoc m :alternatives v))]
+          ["-A" "--disable-alternatives" "Consider only first alternatives"
+           :parse-fn not
+           :assoc-fn (fn [m k v] (assoc m :alternatives v))]
+          ["-f" "--conflict-strat STRAT"
            "May be 'exclusive', 'inclusive' or 'prioritized'."
            :default "exclusive"
            :validate [#(or (= "exclusive" %)


update to version 1.5.4-SNAPSHOT

update to version 1.5.4-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.5.3"
+(defproject cook "1.5.4-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Fix test

Fix test

--- test/buildviz/controllers/builds_test.clj
+++ test/buildviz/controllers/builds_test.clj
@@ -89,6 +89,7 @@
   (testing "PUT with JSON"
     (is (= 204 (:status (json-put-request (the-app) "/builds/somebuild/42/testresults" [{:name "Some Testsuite"
                                                                                :children [{:name "A Test"
+                                                                                :classname "The Class"
                                                                                :runtime 21
                                                                                :status "pass"}]}]))))
     (testing "should store as JUnit XML"


Test: test-list-of-all-jobs-null

Test: test-list-of-all-jobs-null

--- test/clj_jenkins_api/jenkins_api_test.clj
+++ test/clj_jenkins_api/jenkins_api_test.clj
@@ -341,3 +341,10 @@
             (are [x y] (= x y)
                 nil (read-list-of-all-jobs "" "")))))

+(deftest test-list-of-all-jobs-null
+    "Check the clj-jenkins-api.jenkins-api/list-of-all-jobs"
+    (testing "the clj-jenkins-api.jenkins-api/list-of-all-jobs"
+        (with-redefs [http-client/get (fn [url mapa] {:body "null"})]
+            (are [x y] (= x y)
+                nil (read-list-of-all-jobs "" "")))))
+


fs/rename fails silently. Use nio/move instead

--- src/mdr2/repair.clj
+++ src/mdr2/repair.clj
@@ -7,6 +7,7 @@
             [yesql.core :refer [defqueries]]
             [me.raynes.fs :as fs]
             [me.raynes.fs.compression :as compress]
+            [org.tobereplaced.nio.file :as nio]
             [environ.core :refer [env]]
             [clj-http.client :as client]
             [mdr2.obi :as obi]
@@ -74,7 +75,7 @@
         (let [src-path (io/file tar-dir dam-number "produkt" dam-number)
               dest-path (path/structured-path production)]
           (doseq [f (filter #(.isFile %) (file-seq src-path))]
-            (fs/rename f (io/file dest-path (fs/base-name f)))))
+            (nio/move! f (io/file dest-path (fs/base-name f)))))
         ;; clear the temporary files
         (fs/delete tar-file)
         (fs/delete-dir tar-dir)


Fixed nstracker shell notifications for macos

--- src/freecoin/dev.clj
+++ src/freecoin/dev.clj
@@ -30,7 +30,12 @@
             [clojure.java.shell :refer [sh]]))

 (defn- notify [title message]
-  (sh "notify-send" "-t" "500" title message))
+  (case (System/getProperty "os.name")
+    "Mac OS X"
+    (sh "osascript" "-e" (str "display notification \"" message "\" with title \"" title "\""))
+    "Linux"
+    (sh "notify-send" "-t" "500" title message)
+    (log/error "Unsupported operating system")))

 (defn- check-namespace-changes [track]
   (try


added tests for slack adapter (#193)

added tests for slack adapter (#193)

* some more tests

* i dont like all of this london school of TDD - but given the currrent impl, it is kind of required

* add a couple more tests

--- test/yetibot/core/test/adapters/slack.clj
+++ test/yetibot/core/test/adapters/slack.clj
@@ -1,12 +1,16 @@
 (ns yetibot.core.test.adapters.slack
-  (:require [yetibot.core.adapters :as adapters]
-            [yetibot.core.adapters.adapter :as a]
+  (:require [yetibot.core.adapters.adapter :as a]
             [yetibot.core.adapters.slack :as slack]
             [yetibot.core.chat :as chat]
+            [yetibot.core.handler :refer [handle-raw]]
             [clj-slack
              [channels :as channels]
              [users :as slack-users]
-             [groups :as groups]]
+             [groups :as groups]
+             [im :as im]
+             [chat :as slack-chat]]
+            [slack-rtm.core :as slack-rtm]
+            [yetibot.core.models.users :as users]
             [midje.sweet :refer [=> fact facts contains provided
                                  anything every-checker throws]]))

@@ -32,9 +36,9 @@
   "returns only channels YB is in"
   (slack/channels-in anything) => '({:is_member true :name "yes"})
   (provided (slack/list-channels anything) => {:channels [{:is_member true
-                                                  :name "yes"}
-                                                 {:is_member false
-                                                  :name "no"}]})))
+                                                           :name "yes"}
+                                                          {:is_member false
+                                                           :name "no"}]})))

 (facts
  "about chan-or-group-name"
@@ -122,46 +126,281 @@
                                             not-empty
                                             (contains '({:members ["U123"]})))))

-;; functions to test some comment code
-(defn slack-configs []
-  (filter
-   (fn [c] (= "slack" (:type c)))
-   (vals (adapters/adapters-config))))
-
-(def config (slack/slack-config (last (slack-configs))))
-
-(comment
-  ;; replace these with real IDs to try it out
-  (slack/entity-with-name-by-id
-   config {:channel "C11111114"})
-  (slack/entity-with-name-by-id
-   config {:channel "G11111111"})
-  (slack/entity-with-name-by-id
-   config
-   {:type "message"
-    :channel "D11111111"
-    :user "U11111111"
-    :text "!echo hi"})
-
-  ;; test sending a message and getting the history of
-  (let [adapter (first (a/active-adapters))]
-    (slack/history adapter "G1QD1DNG2")
-
-    (binding [chat/*target* "D0HFDJHA4"]
-      (a/send-msg adapter "hi"))
-
-    (slack/react adapter "balloon" "D0HFDJHA4"))
-
-  ;; test bindings when calling an adapter function
-  (let [*config* nil]
-    (binding [*config* (last (slack-configs))]
-      (slack/list-channels))
-
-    (binding [*config* (last (slack-configs))]
-      (slack/channels-cached))
-
-    (binding [*config* (last (slack-configs))]
-      (slack/channels))
-
-    (binding [*config* (last (slack-configs))]
-      (:groups (slack/list-groups)))))
+(facts
+ "about send-msg"
+ (fact
+  "it will attempt to post a message to slack using modified params and log it"
+  (slack/send-msg :config "hello world") => nil
+  (provided (slack-chat/post-message (slack/slack-config :config)
+                                     anything
+                                     "hello world"
+                                     anything)
+            => {:ok true}))
+ (fact
+  "it will attempt to post an image to slack using modified params and log it"
+  (let [img "https://a.a/a.jpg"]
+    (slack/send-msg :config img) => nil
+    (provided (slack-chat/post-message (slack/slack-config :config)
+                                       anything
+                                       img
+                                       anything)
+              => {:ok false})))
+ (fact
+  "it will exercise the code that checks for a truthy *thread-ts* binding,
+   and not throw an error"
+  (binding [yetibot.core.chat/*thread-ts* :threadts]
+    (slack/send-msg :config "hello world") => nil
+    (provided (slack-chat/post-message (slack/slack-config :config)
+                                       anything
+                                       "hello world"
+                                       anything)
+              => {:ok true}))))
+
+(facts
+ "about find-yetibot-user"
+ (fact
+  "it will find the YB user when provided a connection and chat-source"
+  (slack/find-yetibot-user :conn :cs) => true
+  (provided (slack/self :conn) => {:id :myid}
+            (users/get-user :cs :myid) => true)))
+
+(facts
+ "about channel-by-id"
+ (fact
+  "it will get the channel config map based on the id param"
+  (slack/channel-by-id 123 :config) => {:id 123}
+  (provided (slack/channels-cached :config) => [{:id 123}
+                                                {:id 456}])))
+
+(facts
+ "about send-paste"
+ (fact
+  "it will attempt to post a paste message as an attachment to slack using
+   modified params"
+  (slack/send-paste :config "hello world") => :message-posted
+  (provided (slack-chat/post-message (slack/slack-config :config)
+                                     anything
+                                     ""
+                                     anything)
+            => :message-posted))
+ (fact
+  "it will exercise the code that checks for a truthy *thread-ts* binding,
+   and not throw an error"
+  (binding [yetibot.core.chat/*thread-ts* :threadts]
+    (slack/send-paste :config "hello world") => :message-posted
+    (provided (slack-chat/post-message (slack/slack-config :config)
+                                       anything
+                                       ""
+                                       anything)
+              => :message-posted))))
+
+(facts
+ "about history"
+ (fact
+  "it will attempt to retrieve a group's history"
+  (slack/history {:config :myadapter} "GROUPS") => :grouphistory
+  (provided (slack/slack-config :myadapter) => :mycs
+            (groups/history :mycs "GROUPS") => :grouphistory))
+ (fact
+  "it will attempt to retrieve a channel's history"
+  (slack/history {:config :myadapter} "CHANNEL") => :channelhistory
+  (provided (slack/slack-config :myadapter) => :mycs
+            (channels/history :mycs "CHANNEL") => :channelhistory))
+ (fact
+  "it will attempt to retrieve a direct message history"
+  (slack/history {:config :myadapter} "DIRECT") => :directhistory
+  (provided (slack/slack-config :myadapter) => :mycs
+            (im/history :mycs "DIRECT") => :directhistory))
+ (fact
+  "it will throw an exception when it does not recognize the subtype"
+  (slack/history {:config :myadapter} "FAIL") => (throws Exception)
+  (provided (slack/slack-config :myadapter) => :mycs)))
+
+(facts
+ "about start"
+ (fact
+  "it will stop and restart the provided adapter"
+  (slack/start :myadapter nil nil nil) => :didstart
+  (provided (slack/stop :myadapter) => :didstop
+            (slack/restart :myadapter) => :didstart)))
+
+(facts
+ "about stop"
+ (fact
+  "it will reset whether it should ping and refernce the UUID implmentation
+   and send a slack RTM event and reset the connection"
+  (let [ping? (atom true)
+        conn (atom {:dispatcher :myconn})
+        adapter {:should-ping? ping? :conn conn}]
+    (slack/stop adapter) => :didstop
+    (provided (reset! ping? false) => :didreset
+              (a/uuid adapter) => :diduuid
+              (slack-rtm/send-event :myconn :close) => :didsendevent
+              (reset! conn nil) => :didstop))))
+
+(facts
+ "about on-channel-left"
+ (fact
+  "it will get the chat source and remove users in related channel"
+  (let [channel :mychannel
+        cs {:uuid "abc-123" :room :myroom}]
+    (slack/on-channel-left {:channel channel}) => nil
+    (provided (chat/chat-source channel) => cs
+              (users/get-users cs) => []
+              (run! anything []) => nil))))
+
+(facts
+ "about on-channel-joined"
+ (fact
+  "it get the members of the joined channel and add the chat source to the
+   user"
+  (let [id :myid
+        members [:mem1 :mem2]
+        channel {:id id :members members}
+        cs {:uuid "abc-123" :room :myroom}]
+    (slack/on-channel-joined {:channel channel}) => nil
+    (provided (chat/chat-source id) => cs
+              (run! anything members) => nil))))
+
+(facts
+ "about handle-presence-change"
+ (fact
+  "it will get the presence and id of the user and update the user status
+   with the associated adapter"
+  (let [presence "active"
+        user "U123"
+        adapter {:adapter :slack}]
+    (slack/handle-presence-change {:presence presence
+                                   :user user}) => :doupdate
+    (provided (chat/base-chat-source) => adapter
+              (users/update-user adapter user {:active? true}) => :doupdate))))
+
+(facts
+ "about on-presence-change"
+ (fact
+  "it will handle a presence change event and hand it off to
+   (handle-presence-change)"
+  (slack/on-presence-change {}) => :handled
+  (provided (slack/handle-presence-change {}) => :handled)))
+
+(facts
+ "about on-manual-presence-change"
+ (fact
+  "it will handle a manual presence change event and hand it off to
+   (handle-presence-change)"
+  (slack/on-manual-presence-change {}) => :handled
+  (provided (slack/handle-presence-change {}) => :handled)))
+
+(facts
+ "about on-error"
+ (fact
+  "it will log an error - supa-easy, but sad we can't take the value
+   of a macro"
+  (slack/on-error :myexception) => nil))
+
+(facts
+ "about on-connect"
+ (fact
+  "it will reset the atoms associated with the adapter to true and start
+   the pinger"
+  (let [should? (atom false)
+        connect? (atom false)
+        adapter {:should-ping? should?
+                 :connected? connect?}]
+    (slack/on-connect adapter nil) => :doconnect
+    (provided (reset! should? true) => true
+              (reset! connect? true) => true
+              (slack/start-pinger! adapter) => :doconnect))))
+
+(facts
+ "about stop-pinger!"
+ (fact
+  "it will reset the atom associated with the adapter to false"
+  (let [should? (atom true)
+        adapter {:should-ping? should?}]
+    (slack/stop-pinger! adapter) => false
+    (provided (reset! should? false) => false))))
+
+(facts
+ "about on-hello"
+ (fact
+  "it will log a debug about being connected to slack"
+  (slack/on-hello :myevent) => nil))
+
+(facts
+ "about on-channel-join"
+ (fact
+  "it will destruct the event and use the event to get the entity, chat source
+   related user, find the YB user, and pass as a raw 'enter' event using the
+   derived values"
+  (slack/on-channel-join {:channel "C123" :user "U123"} :myconn :myconfig)
+  => :didjoin
+  (provided (slack/entity-with-name-by-id :myconfig
+                                          {:channel "C123"})
+            => ["#C123" {:name "C123"}]
+            (chat/chat-source "#C123") => :mycs
+            (users/get-user :mycs "U123") => :myuser
+            (slack/find-yetibot-user :myconn :mycs) => :ybuser
+            (handle-raw :mycs :myuser :enter :ybuser {}) => :didjoin)))
+
+(facts
+ "about on-channel-leave"
+ (fact
+  "it will destruct the event and use the event to get the entity, chat source
+   related user, find the YB user, and pass as a raw 'leave' event using the
+   derived values"
+  (slack/on-channel-leave {:channel "C123" :user "U123"} :myconn :myconfig)
+  => :didleave
+  (provided (slack/entity-with-name-by-id :myconfig
+                                          {:channel "C123"})
+            => ["#C123" {:name "C123"}]
+            (chat/chat-source "#C123") => :mycs
+            (users/get-user :mycs "U123") => :myuser
+            (slack/find-yetibot-user :myconn :mycs) => :ybuser
+            (handle-raw :mycs :myuser :leave :ybuser {}) => :didleave)))
+
+(facts
+ "about on-message-changed"
+ (fact
+  "it will destruct the event and use the event to get the entity, chat source
+   related user, find the YB user, and pass as a raw 'message' event using the
+   derived values, because this is not the YB user"
+  (let [channel "C123"
+        user "U123"
+        text "my text"
+        cs "#C123"]
+    (slack/on-message-changed {:channel channel
+                               :message {:user user
+                                         :text text
+                                         :thread_ts :mythread}}
+                              :myconn
+                              :myconfig)
+    => :message-changed
+    (provided (slack/entity-with-name-by-id :myconfig
+                                            {:channel channel
+                                             :user user})
+              => [cs {:name channel}]
+              (chat/chat-source cs) => :mycs
+              (users/get-user :mycs user) => {}
+              (slack/find-yetibot-user :myconn :mycs) => :ybuser
+              (handle-raw :mycs
+                          {:yetibot? false}
+                          :message
+                          :ybuser
+                          {:body "my text"}) => :message-changed))))
+
+(facts
+ "about on-pong"
+ (fact
+  "it .."
+  (let [connection-last-active-timestamp (atom 123)
+        connection-latency (atom 123)
+        ping-time (atom 123)]
+    (slack/on-pong {:conn :myconn
+                    :event :myevent
+                    :connection-last-active-timestamp connection-last-active-timestamp
+                    :connection-latency connection-latency
+                    :ping-time ping-time}
+                   :pong-event) => :did-reset-latency
+    (provided (reset! connection-last-active-timestamp anything) => :did-reset-last
+              (reset! connection-latency anything) => :did-reset-latency))))


Supported some kind of renderer

Supported some kind of renderer

--- src/grid/render.cljs
+++ src/grid/render.cljs
@@ -2,15 +2,20 @@
   (:require [quiescent :as q :include-macros true]
             [quiescent.dom :as d]))

+(enable-console-print!)
+
 (q/defcomponent User
   [data header-meta]
   (apply d/tr {}
-         (map (fn [key] (d/td {} (get data key))) (map :key header-meta))))
+         (map (fn [header] (d/td {} (if(get header :renderer)
+                                      (#((get header :renderer) (get data (get header :key))))
+                                      (get data (get header :key)))))
+              (partial header-meta))))

 (defn render-header [header]
   (d/thead {}
            (apply d/tr {}
-                  (map (fn [h] (d/th {:className (:className h)
+                  (map (fn [h] (d/th {:className (:className h)
                                       :onClick (:onClick h)} (:title h)))
                        header))))

@@ -36,7 +41,7 @@
   (if (= identity f)
      reverse
      identity))
-
+
 (defn column-sorter [column]
   (swap! sort-order reverse-sort)
   (update-in my-data [:data] (fn [data] (@sort-order  (sort-by column data)))))
@@ -44,6 +49,10 @@
 (defn create-sorter [f column-key]
   (fn [event reactid]
     (render-grid (f column-key))))
+
+(defn create-email-column-renderer [column-key]
+  (fn [key]
+    (d/a {:className "byline" :href key} key)))

 (def my-data {:data [{:name "John Doe"
                       :email "user@email.com"
@@ -56,7 +65,7 @@
                       :country "France"}]
               :meta {:header
                      [{:key :email :title "Email" :className "email" :onClick
-                       (create-sorter column-sorter :email)}
+                       (create-sorter column-sorter :email) :renderer (create-email-column-renderer)}
                       {:key :name :title "Name"
                        :onClick
                        (create-sorter column-sorter :name)}


better placement for stuff draw in the negative x and y directions

--- src/pc/render.clj
+++ src/pc/render.clj
@@ -20,6 +20,12 @@
   [layer]
   [:path (svg/layer->svg-path layer)])

+;; Getting placement here is a bit tricky.
+;; Goal is to reproduce the canvas exactly as it is in the app, except in
+;; black-and-white so they can print it.
+;; If they've only drawn in positive x and y coordinates, then we're good
+;; If they've drawn in negative directions, then we to shift the viewport in the
+;; that direction with a transform.
 (defn render-layers [layers]
   (let [layers (filter #(not= :layer.type/group (:layer/type %)) layers)
         start-xs (remove #(.isNaN %) (map :layer/start-x layers))
@@ -37,10 +43,17 @@
                 (- max-x min-x))
         height (if (pos? min-y)
                  max-y
-                 (- max-y min-y))]
+                 (- max-y min-y))
+        offset-top (if (neg? min-y)
+                     (+ 250 (- min-y))
+                     0)
+        offset-left (if (neg? min-x)
+                      (+ 250 (- min-x))
+                      0)]
     (html [:svg {:width (+ width 500)
                  :height (+ height 500)
                  :xmlns "http://www.w3.org/2000/svg"
                  :xmlns:xlink "http://www.w3.org/1999/xlink"
                  :version "1.1"}
-           (map svg-element layers)])))
+           [:g {:transform (format "translate(%s, %s)" offset-left offset-top)}
+            (map svg-element layers)]])))


don't need a regex here

don't need a regex here

--- src/pc/server.clj
+++ src/pc/server.clj
@@ -234,7 +234,7 @@
 (defn log-request [req resp ms]
   (when-not (or (re-find #"^/cljs" (:uri req))
                 (and (= 200 (:status resp))
-                     (re-find #"^/health-check$" (:uri req))))
+                     (= "/health-check" (:uri req))))
     (let [cust (-> req :auth :cust)
           cust-str (when cust (str (:db/id cust) " (" (:cust/email cust) ")"))]
       (log/infof "%s: %s %s for %s %s in %sms" (:status resp) (:request-method req) (:uri req) (:remote-addr req) cust-str ms))))


workaround for `omcss$info` appear in classes

--- src/main/om_css/dom.cljs
+++ src/main/om_css/dom.cljs
@@ -57,7 +57,14 @@
            (format-opt-val v))]))
     (reduce (fn [m [k v]]
               (if (= k :className)
-                (assoc m k (string/trim  (str (m k "") (str " " v))))
+                ;; :omcss$info might end up in classes because we're naively
+                ;; adding it to a map that appears in props. A stronger
+                ;; solution might be to check if such map contains the :class keyword
+                ;; but this might introduce other edge cases. Circle back.
+                (let [v' (remove #{:omcss$info "omcss$info"} v)]
+                  (assoc m k
+                    (string/trim
+                      (str (m k "") (str " " (string/replace v #":omcss\$info" ""))))))
                 (cond-> m
                   (not= k :omcss$info) (assoc k v)))) {})))


Make 'unfinished' a synonym for 'only-mocked'

--- src/midje/semi_sweet.clj
+++ src/midje/semi_sweet.clj
@@ -7,6 +7,11 @@
 (def => "=>")   ; So every namespace uses the same qualified name.

 (defmacro only-mocked
+  "Defines a list of names as functions that have no implementation yet. They will
+   throw Errors if ever called."
+  [& names] (only-mocked* names))
+
+(defmacro unfinished
   "Defines a list of names as functions that have no implementation yet. They will
    throw Errors if ever called."
   [& names] (only-mocked* names))


renamed 'circle.yml' tab in Builds page to 'Configuration'

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -642,7 +642,7 @@

                              true
                              (conj {:name :config
-                                    :label (str "circle.yml"
+                                    :label (str "Configuration"
                                                 (when-let [errors (-> build build-model/config-errors)]
                                                   (gstring/format " (%s)" (count errors))))})


Update logging deps

Update logging deps

--- build.boot
+++ build.boot
@@ -41,10 +41,11 @@

    ;; Logging
    [org.clojure/tools.logging "0.3.1"]
-   [org.slf4j/jcl-over-slf4j "1.7.13"]
-   [org.slf4j/jul-to-slf4j "1.7.13"]
-   [org.slf4j/log4j-over-slf4j "1.7.13"]
-   [ch.qos.logback/logback-classic "1.1.3" :exclusions [org.slf4j/slf4j-api]]])
+   [org.slf4j/jcl-over-slf4j "1.7.18"]
+   [org.slf4j/jul-to-slf4j "1.7.18"]
+   [org.slf4j/log4j-over-slf4j "1.7.18"]
+   [ch.qos.logback/logback-classic "1.1.5"
+    :exclusions [org.slf4j/slf4j-api]]])

 (require '[adzerk.boot-cljs :refer [cljs]]
          '[adzerk.boot-cljs-repl :refer [cljs-repl start-repl]]


fix occasionally failing tests

fix occasionally failing tests


Update project name

Update project name

--- build.boot
+++ build.boot
@@ -29,7 +29,7 @@
 (bootlaces! +version+)

 (task-options!
- pom {:project 'hu.ssh/github-changelog
+ pom {:project 'github-changelog
       :version +version+
       :description "GitHub changelog"
       :url "https://github.com/raszi/github-changelog"


Don't gzip original source files

Don't gzip original source files

--- build.boot
+++ build.boot
@@ -121,11 +121,11 @@
   (comp (build-cljs)
         (build-html :metadata-file (str "perun.base." environment ".edn"))
         (build-css)
-        (gzip :regex #{#"\.html$" #"\.css$" #"\.js$"})
+        (gzip :regex #{#"\.html$" #"\.css$" #"^(?!.*main\.out).*\.js$"})
         ;; Fileset gets confused without move to *.orig
         (sift :move {#"^(.*)\.html$" "$1.html.orig"
                      #"^(.*)\.css$" "$1.css.orig"
-                     #"^(.*)\.js$" "$1.js.orig"})
+                     #"^(?!.*main\.out)(.*)\.js$" "$1.js.orig"})
         (sift :to-source #{#"\.orig$"})
         (sift :move {#"^(.*)\.html\.gz$" "$1.html"
                      #"^(.*)\.css\.gz$" "$1.css"


Add my bootlaces

Add my bootlaces

--- build.boot
+++ build.boot
@@ -6,11 +6,14 @@
                  [junit                       "4.12"  ]
                  [org.reflections/reflections "0.9.10"]
                  [org.glassfish/javax.servlet "3.0"   ]
-                 [radicalzephyr/clansi        "1.2.0" ]])
+                 [radicalzephyr/bootlaces     "0.1.12"]])

-(require '[radicalzephyr.boot-junit :refer [junit]])
+(require '[radicalzephyr.bootlaces :refer :all]
+         '[radicalzephyr.boot-junit :refer [junit]])

 (def +version+ "0.1.0")
+
+(bootlaces! +version+)

 (task-options!
  pom  {:project     'radicalzephyr/boot-junit


Fix boot-cljs dep

Fix boot-cljs dep

--- build.boot
+++ build.boot
@@ -3,7 +3,7 @@
   :resource-paths #{"src/clj" "src/cljc"}
   :dependencies '[[org.clojure/clojure    "1.7.0"]
                   [org.clojure/clojurescript "1.7.48"]
-                  [adzerk/boot-cljs       "1.7.48"     :scope "test"]
+                  [adzerk/boot-cljs       "1.7.48-2"   :scope "test"]
                   [adzerk/boot-cljs-repl  "0.1.10-SNAPSHOT" :scope "test"]
                   [adzerk/boot-reload     "0.3.1"      :scope "test"]
                   [deraen/boot-less       "0.4.1"      :scope "test"]


Formatting

Formatting

--- src/riemann/instrumentation.clj
+++ src/riemann/instrumentation.clj
@@ -3,11 +3,11 @@
   (:use [riemann.time :only [unix-time]]
         [riemann.common :only [event localhost]]
         [interval-metrics.core :only [Metric
-                                 update!
-                                 snapshot!
-                                 rate
-                                 quantile
-                                 uniform-reservoir]]))
+                                      update!
+                                      snapshot!
+                                      rate
+                                      quantile
+                                      uniform-reservoir]]))

 (defprotocol Instrumented
   "These things can can be asked to report events about their performance and


Remove unsupported syntax

Remove unsupported syntax

Keywords like ::some-alias/foo work in the clojure reader, but only if
`some-alias` is an alias of a namespace in the current package. That
means that source code that uses keywords like that cannot be read
without compiling. So static analysis breaks on that code.

As far as I can tell these aliased keywords were never intended to work
at all so let's get rid of them and gain some interoperability at the
cost of verbosity.

--- src/rill/event_store/memory.clj
+++ src/rill/event_store/memory.clj
@@ -8,12 +8,12 @@

 (defn with-cursors
   [c events]
-  (map-indexed #(assoc %2 ::message/cursor (+ c %1)) events))
+  (map-indexed #(assoc %2 :rill.message/cursor (+ c %1)) events))

 (deftype MemoryStore [state]
   store/EventStore
   (retrieve-events-since [this stream-id cursor wait-for-seconds]
-    (let [cursor (or (::message/cursor cursor) cursor)]
+    (let [cursor (or (:rill.message/cursor cursor) cursor)]
       (loop [wait wait-for-seconds]
         (let [substream (subvec (get @state stream-id empty-stream) (inc cursor))]
           (if (empty? substream)


define spec find-support-node

define spec find-support-node

--- src/synthesis_crawlers/core.clj
+++ src/synthesis_crawlers/core.clj
@@ -176,9 +176,7 @@
   (conj (into [] (.parents elem)) elem))

 (s/fdef find-reachable-attrs
-        :args (s/cat :attr-nodes (s/map-of string?
-                                           (s/map-of keyword?
-                                                     (s/coll-of #(instance? Element %))))))
+        :args (s/cat :attr-nodes ::attributed-nodes-in-pages))
 (defn find-reachable-attrs
   [attr-nodes]
   (let [result (for [[url attr-nodes] attr-nodes
@@ -192,11 +190,8 @@
             {}
             result)))

-(s/fdef find-reachable-attrs
-        :args (s/cat :attr-nodes (s/map-of string?
-                                           (s/map-of keyword?
-                                                     (s/coll-of #(instance? Element %))))))
-
+(s/fdef find-support-nodes
+        :args (s/cat :attr-nodes ::attributed-nodes-in-pages))
 (defn find-support-nodes
   [url-attr-nodes]
   (let [result (for [[url attr-nodes] url-attr-nodes


changing to reduce

changing to reduce

--- src/vignette/util/thumbnail.clj
+++ src/vignette/util/thumbnail.clj
@@ -28,14 +28,12 @@

 (defn thumbnail-options
   [thumb-map]
-  (loop [acc []
-         params thumb-map]
-    (let [[opt-key val] (first params)
-          opt (get options-map opt-key)]
-      (cond
-        (empty? params) acc
-        (nil? opt) (recur acc (rest params))
-        :else (recur (conj acc (str "--" opt) (str val)) (rest params))))))
+  (reduce (fn [running [opt-key val]]
+            (if-let [opt (get options-map opt-key)]
+              (conj running (str "--" opt) (str val))
+              running))
+          []
+          thumb-map))

 (defn generate-thumbnail
   [resource thumb-map]


make automatic description high priority to concise description

--- src/wb_es/datomic/data/gene.clj
+++ src/wb_es/datomic/data/gene.clj
@@ -16,13 +16,13 @@
                        (cons (:gene/sequence-name entity)))
      :description (or
                    (->> entity
+                        (:gene/automated-description)
+                        (first)
+                        (:gene.automated-description/text))
+                   (->> entity
                         (:gene/concise-description)
                         (first)
-                        (:gene.concise-description/text))
-                   (->> entity
-                        (:gene/automated-description)
-                        (first)
-                        (:gene.automated-description/text)))
+                        (:gene.concise-description/text)))
      :species (data-util/format-entity-species :gene/species entity)
      :allele (->> entity
                   (:variation.gene/_gene)


Remove Home section header and link the comments number to the post page instead of the replies view.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -370,7 +370,7 @@
                   (when comments?
                     [:tr [:td
                       [:a
-                        {:href (:replies-url entry)}
+                        {:href (:url entry)}
                         [:p.digest-post-footer-row
                           [:span.comments-label
                               comment-count-label]]]]])]]]
@@ -428,12 +428,6 @@
            :cellspacing "0"
            :border "0"
            :class "digest-content"}
-          (when following?
-            [:tr
-              [:td
-                [:a.digest-group-link {:href (:url following)}
-                  [:label.digest-group-title
-                    "Home"]]]])
           (when following?
             [:tr
               [:td


removed experiment

removed experiment

--- src/ophion/aggregate.clj
+++ src/ophion/aggregate.clj
@@ -282,12 +282,6 @@
        {:percentile "$$index.percentile"
         :start "$$index.start._id.max"}}}}}])

-;; (mongo/disk-aggregate
-;;  db "Gene"
-;;  [{:$facet
-;;    {:start
-;;     [{:$bucketAuto {:groupBy "$start" :buckets 100 :output {:start {:$max "$start"}}}} {:$project {:start "$start"}}]}} {:$project {:start {:$map {:input [1 5 10] :as "index" :in {:percentile "$$index" :start {:$arrayElemAt ["$start", "$$index"]}}}}}} {:$project {:start {:$map {:input "$start" :as "index" :in {:percentile "$$index.percentile" :start "$$index.start.start"}}}}}])
-
 (defn render-aggregate
   [[key query]]
   (let [op (keyword (first (keys query)))


Hold your horses! We're not at 0.10.1 yet...

--- src/overtone/version.clj
+++ src/overtone/version.clj
@@ -2,7 +2,7 @@

 (def OVERTONE-VERSION {:major 0
                        :minor 10
-                       :patch 1
+                       :patch 0
                        :snapshot true})

 (def OVERTONE-VERSION-STR


cleanup

cleanup

--- test/clj/elephantdb/shard_test.clj
+++ test/clj/elephantdb/shard_test.clj
@@ -1,15 +0,0 @@
-(ns elephantdb.config-test
-  (:use clojure.test)
-  (:use [elephantdb shard testing]))
-
-(defn run-shard-test [numhosts numshards replication]
-  ;TODO finish
-  )
-
-(deftest test-sharder
-  (run-shard-test 1 1 1)
-  (run-shard-test 1 10 1)
-  (run-shard-test 2 2 1)
-  (run-shard-test 2 10 2)
-  (run-shard-test 20 64 3)
-  )


fixing error message

fixing error message

--- src/proxmox/provider.clj
+++ src/proxmox/provider.clj
@@ -16,7 +16,7 @@
   )

 (def str? [string? :msg "not a string"])
-(def vec? [vector? :msg "not a string"])
+(def vec? [vector? :msg "not a vector"])

 (def ct-validations


Delete to lower case to allow tests to pass

--- test/etcd_clojure/core_test.clj
+++ test/etcd_clojure/core_test.clj
@@ -26,7 +26,7 @@
 (deftest test-delete
   (testing "should delete a value"
     (etcd/set "foo" "bar")
-    (is (= "DELETE" (get (etcd/delete "foo") "action")))))
+    (is (= "delete" (get (etcd/delete "foo") "action")))))

 (deftest test-get
   (testing "should get a value"


just disable delete button in read-only mode

--- app/src/semtag_web/rendering.cljs
+++ app/src/semtag_web/rendering.cljs
@@ -333,13 +333,16 @@
   (enable-editable-table "#all_table" input-queue)
   (enable-clickable-links-on "#all_table td:not([data-field=url])" input-queue))

-(defn- enable-delete-thing
-  [input-queue id]
-  (events/send-on :click
-                  (css/sel "td.delete button")
-                  input-queue
-                  (fn [event]
-                    [{msg/type :map-value msg/topic [:action] :value :delete-thing :params {:id id}}])))
+(if (:read-only config/config)
+  (defn- enable-delete-thing [input-queue id])
+
+  (defn- enable-delete-thing
+    [input-queue id]
+    (events/send-on :click
+                    (css/sel "td.delete button")
+                    input-queue
+                    (fn [event]
+                      [{msg/type :map-value msg/topic [:action] :value :delete-thing :params {:id id}}]))))

 (defn render-thing-results [_ [_ path _ new-value] input-queue]
   (let [thing-id (-> path path->params :id)


Add lazy sequences to body rendering

Add lazy sequences to body rendering

--- src/yada/body.clj
+++ src/yada/body.clj
@@ -96,6 +96,10 @@
   (to-body [v representation]
     (encode-message (render-seq v representation) representation))

+  clojure.lang.LazySeq
+  (to-body [v representation]
+    (encode-message (render-seq v representation) representation))
+
   java.util.HashSet
   (to-body [v representation]
     (encode-message (render-seq v representation) representation))


Processing function for atomic typos

Processing function for atomic typos

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -94,6 +94,15 @@
                              (db-interface/read-words-for-pattern word :blacklist))]
         (finish-processing request search-results nil title emender-page :blacklist)))

+(defn process-atomic-typos
+    "Function that prepares data for the Atomic typos front page."
+    [request title emender-page]
+    (let [params         (:params request)
+          word           (get params "word")
+          search-results (if (not (empty? word))
+                             (db-interface/read-words-for-pattern word :atomic-typos))]
+        (finish-processing request search-results nil title emender-page :atomic-typos)))
+
 (defn add-word-message
     [word proper-word]
     (if (seq word)
@@ -323,12 +332,16 @@
             "/"                           (process-front-page    request title emender-page)
             "/whitelist"                  (process-whitelist     request title emender-page)
             "/blacklist"                  (process-blacklist     request title emender-page)
+            "/atomic-typos"               (process-atomic-typos  request title emender-page)
             "/all-words-in-whitelist"     (process-all-words     request title emender-page :whitelist)
             "/all-words-in-blacklist"     (process-all-words     request title emender-page :blacklist)
+            "/all-words-in-atomic-typos"  (process-all-words     request title emender-page :atomic-typos)
             "/active-words-in-whitelist"  (process-active-words  request title emender-page :whitelist)
             "/active-words-in-blacklist"  (process-active-words  request title emender-page :blacklist)
-            "/deleted-words-in-whitelist" (process-deleted-words request title emender-page :whitelist)
-            "/deleted-words-in-blacklist" (process-deleted-words request title emender-page :blacklist)
+            "/active-words-in-atomic-typos"  (process-active-words     request title emender-page :atomic-typos)
+            "/deleted-words-in-whitelist"    (process-deleted-words request title emender-page :whitelist)
+            "/deleted-words-in-blacklist"    (process-deleted-words request title emender-page :blacklist)
+            "/deleted-words-in-atomic-typos" (process-deleted-words     request title emender-page :atomic-typos)
             "/add-word-to-blacklist"  (process-add-word      request title emender-page :blacklist)
             ;"/find-words"       (process-find-words    request)
             "/add-words-to-whitelist" (process-add-words     request title emender-page :whitelist)


Allow deleting and undeleting words on the 'search' page

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -75,24 +75,6 @@
     [request title emender-page]
     (let [params         (:params request)]
         (finish-processing request nil nil nil title emender-page :whitelist)))
-
-(defn process-whitelist
-    "Function that prepares data for the whitelist front page."
-    [request title emender-page]
-    (let [params         (:params request)
-          word           (get params "word")
-          search-results (if (not (empty? word))
-                             (db-interface/read-words-for-pattern word :whitelist))]
-        (finish-processing request search-results nil nil title emender-page :whitelist)))
-
-(defn process-blacklist
-    "Function that prepares data for the blacklist front page."
-    [request title emender-page]
-    (let [params         (:params request)
-          word           (get params "word")
-          search-results (if (not (empty? word))
-                             (db-interface/read-words-for-pattern word :blacklist))]
-        (finish-processing request search-results nil nil title emender-page :blacklist)))

 (defn process-atomic-typos
     "Function that prepares data for the Atomic typos front page."
@@ -180,6 +162,26 @@
               (db-interface/delete-word to-delete mode))
           (if to-undelete
               (db-interface/undelete-word to-undelete mode))))
+
+(defn process-whitelist
+    "Function that prepares data for the whitelist front page."
+    [request title emender-page]
+    (perform-operation request :whitelist)
+    (let [params         (:params request)
+          word           (get params "word")
+          search-results (if (not (empty? word))
+                             (db-interface/read-words-for-pattern word :whitelist))]
+        (finish-processing request search-results nil nil title emender-page :whitelist)))
+
+(defn process-blacklist
+    "Function that prepares data for the blacklist front page."
+    [request title emender-page]
+    (perform-operation request :blacklist)
+    (let [params         (:params request)
+          word           (get params "word")
+          search-results (if (not (empty? word))
+                             (db-interface/read-words-for-pattern word :blacklist))]
+        (finish-processing request search-results nil nil title emender-page :blacklist)))

 (defn process-all-words
     "Read all words from the selected dictionary and display them to user on generated page."


Clean up product test

Clean up product test

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -735,35 +735,37 @@
 (defn run-self-join-prop [min-keys key-len actions movements]
   (let [tree (apply-to-tree (tree min-keys key-len) actions)
         iterator-results (apply-to-iterator (iterator tree) movements)
-        iterator-a (iterator tree)
-        iterator-b (iterator tree)
         join-results (apply-to-iterator
-                      (join #js [iterator-a iterator-b] key-len #js [(into-array (repeat key-len true)) (into-array (repeat key-len true))])
+                      (join #js [(iterator tree) (iterator tree)] key-len #js [(into-array (repeat key-len true)) (into-array (repeat key-len true))])
                       movements)]
     (= (map vec iterator-results) (map vec join-results))))

 (defn self-join-prop [key-len]
   (prop/for-all [min-keys gen/s-pos-int
                  actions (gen/vector (gen-action key-len))
-                 movements (gen/vector (gen-next key-len))] ;; TODO use gen-movement once Treeterator supports seek
+                 movements (gen/vector (gen-next key-len))] ;; TODO implement Join.seek
                 (run-self-join-prop min-keys key-len actions movements)))

 (defn run-product-join-prop [min-keys key-len actions movements]
-  (let [tree (apply-to-tree (tree min-keys key-len) actions)
-        iterator-results (apply-to-iterator (iterator tree) movements)
-        iterator-a (trieterator (iterator tree))
-        iterator-b (trieterator (iterator tree))
+  (let [product-tree (tree min-keys key-len)
+        tree (apply-to-tree (tree min-keys key-len) actions)
+        elems #js []
+        _ (.into tree elems)
+        _ (dotimes [i (alength elems)]
+            (dotimes [j (alength elems)]
+              (.assoc! product-tree (.concat (aget elems i 0) (aget elems j 0)) nil)))
+        iterator-results (apply-to-iterator (iterator product-tree) movements)
         join-results (apply-to-iterator
-                      (treeterator (join #js [iterator-a iterator-b] (* 2 key-len) #js [(into-array (range key-len)) (into-array (range key-len (* 2 key-len)))]))
+                      (join #js [(iterator tree) (iterator tree)] (* 2 key-len) #js [(into-array (concat (repeat key-len true) (repeat key-len false)))
+                                                                                (into-array (concat (repeat key-len false) (repeat key-len true)))])
                       movements)]
     (= (map vec iterator-results) (map vec join-results))))

 (defn product-join-prop [key-len]
   (prop/for-all [min-keys gen/s-pos-int
                  actions (gen/vector (gen-action key-len))
-                 movements (gen/vector (gen-next key-len))] ;; TODO use gen-movement once Treeterator supports seek
+                 movements (gen/vector (gen-next key-len))] ;; TODO implement Join.seek
                 (run-product-join-prop min-keys key-len actions movements)))
-

 (defn magic-run-product-join-prop [min-keys key-len actions]
   (let [tree (apply-to-tree (tree min-keys key-len) actions)


Update ranges. Add a new failing test.

Update ranges. Add a new failing test.

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -130,8 +130,21 @@
                        (set! (.-parent child) this))))
                  (if (> (alength keys) max-keys)
                    (.split! this max-keys)
-                   (when (and (< (alength keys) min-keys) (instance? Node parent))
-                     (.rotate-left! this max-keys))))))
+                   (if (and (< (alength keys) min-keys) (instance? Node parent))
+                     (.rotate-left! this max-keys)
+                     (do
+                       (.update-lower! this (if (nil? children) (aget keys 0) (.-lower (aget children 0))))
+                       (.update-upper! this (if (nil? children) (aget keys (- (alength keys) 1)) (.-upper (aget children (- (alength children) 1)))))))))))
+  (update-lower! [this new-lower]
+                 (when-not (== lower new-lower)
+                   (set! lower new-lower)
+                   (when (and (instance? Node parent) (== parent-ix 0))
+                     (.update-lower! parent new-lower))))
+  (update-upper! [this new-upper]
+                 (when-not (== upper new-upper)
+                   (set! upper new-upper)
+                   (when (and (instance? Node parent) (== parent-ix (- (alength (.-children parent)) 1)))
+                     (.update-upper! parent new-upper))))
   (split! [this max-keys]
           (let [median (js/Math.floor (/ (alength keys) 2))
                 right-node (Node. parent (+ parent-ix 1) #js [] #js [] (when-not (nil? children) #js []) nil nil)]
@@ -196,21 +209,21 @@
             (assert (<= (count keys) max-keys) (pr-str keys max-keys))
             (assert (= (count keys) (count (set keys))))
             (assert (= (seq keys) (seq (sort-by identity #(cond (== %1 %2) 0 (lt %1 %2) -1 (gt %1 %2) 1) keys))))
-            #_(assert (every? #(lte lower %) keys) (pr-str lower keys))
-            #_(assert (every? #(gte upper %) keys) (pr-str upper keys))
+            (assert (every? #(lte lower %) keys) (pr-str lower keys))
+            (assert (every? #(gte upper %) keys) (pr-str upper keys))
             (if (nil? children)
               (do
                 (assert (= (count keys) (count vals)) (pr-str keys vals))
-                #_(assert (= lower (aget keys 0)) (pr-str lower keys))
-                #_(assert (= upper (aget keys (- (alength keys) 1))) (pr-str upper keys)))
+                (assert (= lower (aget keys 0)) (pr-str lower keys))
+                (assert (= upper (aget keys (- (alength keys) 1))) (pr-str upper keys)))
               (do
                 (dotimes [ix (count children)]
                   (assert (= ix (.-parent-ix (aget children ix)))))
                 (assert (= (count keys) (count vals) (dec (count children))) (pr-str keys vals children))
-                #_(assert (= lower (.-lower (aget children 0))) (pr-str lower (.-lower (aget children 0))))
-                #_(assert (= upper (.-upper (aget children (- (alength children) 1)))) (pr-str upper (.-upper (aget children (- (alength children) 1)))))
-                #_(assert (every? #((fn [a b] (gt a b)) (aget keys %) (.-upper (aget children %))) (range (count keys))))
-                #_(assert (every? #((fn [a b] (lt a b)) (aget keys %) (.-lower (aget children (inc %)))) (range (count keys))))
+                (assert (= lower (.-lower (aget children 0))) (pr-str lower (.-lower (aget children 0))))
+                (assert (= upper (.-upper (aget children (- (alength children) 1)))) (pr-str upper (.-upper (aget children (- (alength children) 1)))))
+                (assert (every? #((fn [a b] (gt a b)) (aget keys %) (.-upper (aget children %))) (range (count keys))))
+                (assert (every? #((fn [a b] (lt a b)) (aget keys %) (.-lower (aget children (inc %)))) (range (count keys))))
                 (dotimes [i (count children)] (.valid! (aget children i) max-keys))))))
   (pretty-print [this]
                 (str "(" parent-ix ")" "|" (pr-str lower) " " (pr-str (vec keys)) " " (pr-str upper) "|")))
@@ -416,7 +429,11 @@
                  movements (gen/vector gen-movement)]
                 (run-iterator-prop min-keys actions movements)))

-;; TODO iterator tests
+(run-building-prop 1
+                   [[:assoc! 90 0] [:assoc! 0 0] [:assoc! 1 0]
+                    [:assoc! 2 0] [:assoc! -1 0] [:assoc! -2 0]
+                    [:assoc! "" 0] [:assoc! 91 0] [:assoc! " " 0]
+                    [:assoc! 3 0] [:dissoc! 90]])

 (comment
   (dc/quick-check 1000 least-prop)
@@ -427,7 +444,7 @@
   (dc/quick-check 1000 anti-symmetric-prop)
   (dc/quick-check 1000 total-prop)
   (dc/quick-check 100 (building-prop gen-assoc))
-  (dc/quick-check 100 (building-prop gen-action))
+  (dc/quick-check 1000 (building-prop gen-action))
   (dc/quick-check 100 (lookup-prop gen-action))
   (dc/quick-check 100 iterator-prop)


comments and logging

comments and logging

--- src/babel/engine.cljc
+++ src/babel/engine.cljc
@@ -41,6 +41,7 @@
                                             do-enrich true
                                             max-total-depth generate/max-total-depth
                                             truncate-children true}}]
+  (log/debug (str "engine/generate with spec " (strip-refs spec) " and max-total-depth: " max-total-depth))
   (let [grammar (:grammar language-model)]
     (if (empty? grammar)
       (do
@@ -95,6 +96,7 @@
                        :truncate-children truncate-children
                        :max-total-depth max-total-depth)))

+;; TODO: consider removing this function; not commonly used.
 ;; TODO: use a option map/destructuring thing.
 (defn generate-all [spec language-model & [{add-subcat :add-subcat
                                             do-enrich :do-enrich}]]


more logging to resolve generation problem in english

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -110,38 +110,46 @@

         depth (if depth depth 0)
         ;; TODO: unifyc is expensive: factor out into a let.
-        debug (log/debug (str "looking for candidate parents with parent: " (:rule parent) " and spec: " (strip-refs spec)))
-        candidate-parents (filter #(not (fail? %))
+        debug (log/debug (str "looking for candidate head phrases with parent: " (:rule parent) " and spec: " (strip-refs spec)))
+        candidate-heads (filter #(not (fail? %))
                                   (map (fn [rule]
-                                         (do (log/debug (str "testing rule::: " (:rule rule)))
-                                             (log/debug (str " result: " (unifyc spec rule)))
+                                         (do (log/debug (str "testing rule: " (:rule rule)))
+                                             (log/debug (str "RULE:" (strip-refs rule)))
+                                             (if (fail? rule)
+                                               (throw (exception (str "THE RULE IS FAIL: " (strip-refs rule)))))
+                                             (log/debug (str " result: " (strip-refs (unifyc spec rule))))
                                              (log/debug (if (fail? (unifyc spec rule))
                                                           (str "fail path: " (fail-path-between spec rule))
                                                           (str "rule: " (:rule rule) " successfully unified with spec: " (strip-refs spec))))
                                              (unifyc spec rule)))
-                                       (if parent (get-head-phrases-of parent index)
-                                           grammar)))
-
-        debug (log/debug (str "done looking for candidate parents: "
-                              (if (empty? candidate-parents)
-                                "no candidate parents found."
-                                (str "one or more candidate parents found; first: " (:rule (first candidate-parents))))))
+                                       (if parent
+                                         (let [hp (get-head-phrases-of parent index)]
+                                           (log/debug (str "GETTING HEAD PHRASES: hp"))
+                                           hp)
+                                         (do
+                                           (log/debug (str "NOT GETTING HEAD PHRASES: using grammar"))
+                                           grammar))))
+
+        debug (log/debug (str "done looking for candidate heads: "
+                              (if (empty? candidate-heads)
+                                "no candidate heads found."
+                                (str "one or more candidate heads found; first: " (:rule (first candidate-heads))))))

-        debug (if (not (empty? candidate-parents))
-                (log/debug (str "candidate-parents: " (string/join "," (map #(get-in % [:rule])
-                                                                            candidate-parents))))
-                (log/debug (str "no candidate-parents for spec: " (strip-refs spec))))]
+        debug (if (not (empty? candidate-heads))
+                (log/debug (str "candidate-heads: " (string/join "," (map #(get-in % [:rule])
+                                                                            candidate-heads))))
+                (log/debug (str "no candidate-heads for spec: " (strip-refs spec))))]
     ;; TODO: remove or parameterize this hard-coded value.
     (if (> depth 5)
       (throw (exception (str "DEPTH IS GREATER THAN 5; HOW DID YOU END UP IN THIS TERRIBLE SITUATION? LOOK AT THE STACK. I'M OUTTA HERE."))))

-    (if (seq candidate-parents)
+    (if (seq candidate-heads)
       (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
             (mapcat (fn [parent]
                       (let [head-is-phrasal (get-in parent [:head :phrasal] false)
                             candidate-lexemes (if (not (= true head-is-phrasal))
                                                 (get-lex parent :head index spec))]
-                        (log/trace
+                        (log/debug
                          (str "candidate head lexemes for parent phrase "
                               (get-in parent [:rule]) ": "
                               (string/join ","
@@ -161,7 +169,7 @@
                                                          (map #(morph %1)
                                                               result)))))
                           result)))
-                    candidate-parents)
+                    candidate-heads)

             ;; TODO: throw exception if (get-in parent [:head]) is null.
             phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
@@ -175,7 +183,7 @@
                                               (+ 1 depth)
                                               index parent morph)]
                           (if (empty? phrasal-children)
-                            (let [message (str "no phrasal children for parent: " (morph parent) "(rule=" (get-in parent [:rule]) ")" )]
+                            (let [message (str "no phrasal children for parent: " (morph parent) "(rule=" (get-in parent [:rule]) ") and spec: " (strip-refs spec))]
                               (log/debug message))
                             ;; else; there are phrasal-children, so attach them below parent:
                             (do
@@ -185,7 +193,7 @@
                               (over/overh parent phrasal-children morph)))
                           )
                         )
-                       candidate-parents))]
+                       candidate-heads))]
         (if (lexemes-before-phrases)
           (lazy-cat lexical phrasal)
           (lazy-cat phrasal lexical))))))
@@ -207,6 +215,7 @@
             cached (if (and true cache)
                      (do
                        (let [result (get-lex immediate-parent :comp cache spec)]
+                         (log/debug (str "GET-LEX: " (string/join " " (map morph result))))
                          (if (not (nil? result))
                            (log/debug (str " cached lexical subset ratio: "
                                            (string/replace (str (/ (* 1.0 (/ (count lexicon) (count result)))))
@@ -217,7 +226,7 @@
                          nil))
             complement-candidate-lexemes (if (not (= true
                                                      (get-in bolt (concat path [:phrasal]))))
-                                           (if false cached (flatten (vals lexicon))))]
+                                           (if cached cached (flatten (vals lexicon))))]
         (let [semantics (get-in spec [:synsem :sem])]
           (if (not (nil? semantics))
             (if (not (nil? semantics)) (log/debug (str "  with semantics:" (strip-refs semantics))))))
@@ -236,7 +245,9 @@

               return-val
               (filter (fn [result]
-                        (not (fail? result)))
+                        (do
+                          (log/debug (str "LOOKING AT RESULT:  " result))
+                          (not (fail? result))))
                       (map (fn [complement]
                              (let [debug (log/debug (str "adding complement to: ["
                                                          (get-in bolt [:rule]) " "
@@ -259,8 +270,16 @@

                            ;; lazy-sequence of phrasal complements to pass one-by-one to the above (map)'s function.
                            (do
-                             (log/debug (str "generating lexical complements with spec: " (strip-refs spec)))
+                             (log/debug (str "generating phrasal complements with spec: " (strip-refs spec)))
                              (let [phrasal-complements (generate-all spec grammar lexicon cache morph)]
+                               (log/debug (str "number of phrasal components given spec: " spec ":"
+                                               (count phrasal-complements)))
+                               (if (> (count phrasal-complements) 0)
+                                 (log/debug (str "phrasal complements given spec: " spec ":"
+                                                 (string/join "," (map morph phrasal-complements))))
+                                 (log/debug (str "phrasal complements of spec: " spec ":"
+                                                 "were empty.")))
+
                                (if (lexemes-before-phrases)
                                  (lazy-cat shuffled-candidate-lexical-complements phrasal-complements)
                                  (do
@@ -272,48 +291,43 @@
             (if (empty? return-val)

               ;; else, no complements could be added to this bolt: Throw an exception
-              (let [log-limit 100
-                    log-fn (if (= (get-in bolt (concat path [:phrasal]))
-                                  false)
-                             (fn [message] (log/debug message));; since complement must be phrasal, less logging
-
-                             ;; else: should have found a lexical complement: log all problems: provide logging for diagnostics.
-                             (fn [message] (log/error message)))
+              (let [log-limit 1000
+                    log-fn (fn [message] (log/error message))
                     throw-exception-if-no-complements-found true
                     message
-                    (cond (= (get-in bolt (concat path [:phrasal]))
-                             true)
-                          (str "skipping logging about lexical complements since bolt wants a phrasal complement.")
-                          true
-                          (str " add-complement to " (get-in bolt [:rule]) " at path: " path " took " run-time " msec, but found no lexical complements for "
-                               "'" (morph from-bolt) "'"
-                               ". Bolt wants phrasal-wise: " (get-in bolt (concat path [:phrasal]))
-                               ". Desired complement [:synsem] was: " (strip-refs (get-in bolt (concat path [:synsem])))
-                               ". " (count complement-candidate-lexemes) " complement(s) tried were:"
-                               (str " "
-                                    (string/join "," (sort (map morph (take log-limit complement-candidate-lexemes))))
-
-                                    (if (< 0 (- (count complement-candidate-lexemes) log-limit))
-                                      (str ",.. and "
-                                           (- (count complement-candidate-lexemes) log-limit) " more."))
-
-                                    ";     with preds:   "
-                                    (string/join "," (map #(get-in % [:synsem :sem :pred]) (take log-limit complement-candidate-lexemes)))
-
-                                    ";     fail-paths:   "
-                                    (string/join ","
-                                                 (map #(if
-                                                           (or true (not (fail? (unifyc (get-in % [:synsem :sem :pred])
-                                                                                (get-in bolt (concat path
-                                                                                [:synsem :sem :pred]))))))
-                                                             (str "'" (morph %) "':"
-                                                                  (fail-path-between (strip-refs %)
-                                                                                (strip-refs (get-in bolt path)))))
-                                                          (take log-limit complement-candidate-lexemes)))
-
-                                    (if (< 0 (- (count complement-candidate-lexemes) log-limit))
-                                      (str ",.. and "
-                                           (- (count complement-candidate-lexemes) log-limit) " more.")))))]
+                    (str " add-complement to " (get-in bolt [:rule]) " at path: " path
+                         " took " run-time " msec, but found neither phrasal nor lexical complements for "
+                         "'" (morph from-bolt) "'"
+                         ". Bolt wants phrasal-wise: " (get-in bolt (concat path [:phrasal]))
+                         ". Desired complement [:synsem] was: "
+                         (strip-refs (get-in bolt (concat path [:synsem]))) ". "
+                         (if (= false (get-in bolt (concat path [:phrasal]) false))
+                           (str
+                            (count complement-candidate-lexemes) " lexical complement(s) tried were:"
+                            " "
+                            (string/join "," (sort (map morph (take log-limit complement-candidate-lexemes))))
+
+                            (if (< 0 (- (count complement-candidate-lexemes) log-limit))
+                              (str ",.. and "
+                                   (- (count complement-candidate-lexemes) log-limit) " more."))
+
+                            ";     with preds:   "
+                            (string/join "," (map #(get-in % [:synsem :sem :pred]) (take log-limit complement-candidate-lexemes)))
+
+                            ";     fail-paths:   "
+                            (string/join ","
+                                         (map #(if
+                                                   (or true (not (fail? (unifyc (get-in % [:synsem :sem :pred])
+                                                                                (get-in bolt (concat path
+                                                                                [:synsem :sem :pred]))))))
+                                                 (str "'" (morph %) "':"
+                                                      (fail-path-between (strip-refs %)
+                                                                         (strip-refs (get-in bolt path)))))
+                                              (take log-limit complement-candidate-lexemes)))
+
+                            (if (< 0 (- (count complement-candidate-lexemes) log-limit))
+                              (str ",.. and "
+                                   (- (count complement-candidate-lexemes) log-limit) " more.")))))]
                 (log-fn message)

                 ;; set to true to work on optimizing generation, since this situation of failing to add any


add docstrings & validation to macroexpand & macroexpand-1

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -1973,11 +1973,24 @@
 (defmacro load-file* [f]
   `(. js/goog (~'nodeGlobalRequire ~f)))

-(defmacro macroexpand-1 [[quote form]]
-  `(quote ~(ana/macroexpand-1 &env form)))
-
-(defmacro macroexpand [[quote form]]
-  (core/let [env &env]
+(defmacro macroexpand-1
+  "If form represents a macro form, returns its expansion,
+  else returns form."
+  [quoted]
+  (core/assert (core/= (core/first quoted) 'quote)
+    "Argument to macroexpand-1 must be quoted")
+  (core/let [form (second quoted)]
+    `(quote ~(ana/macroexpand-1 &env form))))
+
+(defmacro macroexpand
+  "Repeatedly calls macroexpand-1 on form until it no longer
+  represents a macro form, then returns it.  Note neither
+  macroexpand-1 nor macroexpand expand macros in subforms."
+  [quoted]
+  (core/assert (core/= (core/first quoted) 'quote)
+    "Argument to macroexpand must be quoted")
+  (core/let [form (second quoted)
+             env &env]
     (core/loop [form' (ana/macroexpand-1 env form)]
       (core/if-not (core/identical? form form')
         (recur (ana/macroexpand-1 env form))


Unify should skip rendering if mapping fn returns nil.

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -95,7 +95,7 @@

     ;;For each datum, update existing nodes and add new ones
     (doseq [[idx d] (map-indexed vector data)]
-      (let [new-node (mapping d idx)]
+      (when-let [new-node (mapping d idx)]
         ;;If there's an existing node
         (if-let [old (existing-nodes-by-key (key-fn d idx))]
           (do


Fix bug when merging DOM nodes that have case-sensitive names (e.g. "foreignObject").

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -48,8 +48,8 @@
   re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

 (defn merge-dom [dom-node el]
-  (when (not= (keyword (.toLowerCase (.-nodeName dom-node)))
-              (:tag el))
+  (when (not= (.toLowerCase (.-nodeName dom-node))
+              (.toLowerCase (name (:tag el))))
     (throw "Cannot merge el into node of a different type"))

   (dom/attr dom-node (:attr el))
@@ -57,7 +57,7 @@
     (dom/text dom-node txt))
   (iter {for [dom-child el-child] in (map vector (children dom-node)
                                           (remove string? (:children el)))}
-        (merge-dom dom-child  el-child)))
+        (merge-dom dom-child el-child)))

 (def xmlns {:xhtml "http://www.w3.org/1999/xhtml"


Don't reinvent goog.math.clamp

Don't reinvent goog.math.clamp

Signed-off-by: Christian Romney <78cb0763aa1664e7dd86fd558ae466f67ab17826@pointslope.com>

--- src/cljs/svg/app.cljs
+++ src/cljs/svg/app.cljs
@@ -31,13 +31,6 @@
   [key func]
   (let [handlers (vec (get @event-handlers key))]
     (swap! event-handlers assoc key (conj handlers func))))
-
-(defn- make-constraint
-  "Creates a function that keeps a supplied number within the set bounds"
-  [minimum maximum]
-  (fn [num]
-    (let [local-max (if (<= num maximum) num maximum)]
-      (if (<= minimum local-max) local-max minimum))))

 ;;; Event Handlers

@@ -143,9 +136,8 @@
      (fn [this]
        (let [node (r/dom-node this)
              canvas (-> node .-parentNode)
-             x-constraint (->> canvas .-clientWidth (make-constraint 0))
-             y-constraint (->> canvas .-clientHeight (make-constraint 0))]
-
+             x-constraint #(gmath/clamp % 0 (.-clientWidth canvas))
+             y-constraint #(gmath/clamp % 0 (.-clientHeight canvas))]
          ;; get my component-local
          (goog.events/listen
           node


Added the ability to reset history.

Added the ability to reset history.

--- src/cljs/svg/app.cljs
+++ src/cljs/svg/app.cljs
@@ -18,23 +18,28 @@
     (fn [db]
       (when-not @active
         (swap! h #(conj % @db)))
-      [:div {:class "form-group"}
-       [:label {:for "history"} "History"]
-       [:input {:type "range"
-                :class "form-control"
-                :name "history"
-                :min 0
-                :max (count @h)
-                :onChange (fn [e]
-                            (when (> (count @h) 0)
-                              (reset! active true)
-                              (->> e
-                                 (.-target)
-                                 (.-value)
-                                 (from-history db h)
-                                 )))
-                :onBlur (fn [e] (reset! active false))
-                }]])))
+      [:div {:class "wrapper"}
+       [:div {:class "form-group"}
+        [:button {:class "btn btn-default"
+                  :onClick (fn [e] (reset! h []))} "History Reset"]
+        ]
+       [:div {:class "form-group"}
+        [:label {:for "history"} "History"]
+        [:input {:type "range"
+                 :class "form-control"
+                 :name "history"
+                 :min 0
+                 :max (count @h)
+                 :onChange (fn [e]
+                             (when (> (count @h) 0)
+                               (reset! active true)
+                               (->> e
+                                  (.-target)
+                                  (.-value)
+                                  (from-history db h)
+                                  )))
+                 :onBlur (fn [e] (reset! active false))
+                 }]]])))

 (defn click-count-component
   [clicks]


added tuple method to create tuples

added tuple method to create tuples

--- src/clojerl/types.clj
+++ src/clojerl/types.clj
@@ -52,7 +52,11 @@

   clojure.lang.PersistentVector
   (to-erlang [e]
-    (container-to-erlang e)))
+    (container-to-erlang e))
+
+  OtpErlangObject
+  (to-erlang [e] e))
+

 (extend-protocol ErlangToClojure
   OtpErlangLong
@@ -86,3 +90,7 @@

 (defn encode-binary [e]
   (OtpErlangBinary. e))
+
+(defn tuple [col]
+  (OtpErlangTuple. (into-array OtpErlangObject
+                               (mapv to-erlang col))))


fix: grammar (#534)

fix: grammar (#534)

--- src/re_frame/fx.cljc
+++ src/re_frame/fx.cljc
@@ -134,7 +134,7 @@
   :dispatch-n
   (fn [value]
     (if-not (sequential? value)
-      (console :error "re-frame: ignoring bad :dispatch-n value. Expected a collection, got got:" value)
+      (console :error "re-frame: ignoring bad :dispatch-n value. Expected a collection, but got:" value)
       (doseq [event (remove nil? value)] (router/dispatch event)))))


Remove trailing whitespace.

Remove trailing whitespace.

--- src/datoteka/core.clj
+++ src/datoteka/core.clj
@@ -406,4 +406,3 @@
   (make-output-stream [path opts]
     (let [^OutputStream os (path->output-stream path)]
       (io/make-output-stream os opts))))
-


Fixed how the server starts after generalising to authentication level

--- src/freecoin/core.clj
+++ src/freecoin/core.clj
@@ -181,9 +181,14 @@
                                 {:ttl-password-recovery (config/ttl-password-recovery config-m)})
             blockchain         (blockchain/new-mongo stores-m)
             email-conf         (clojure.edn/read-string (slurp (:email-config config-m)))
-            email-authenticator    (just-auth.messaging/->AccountActivator email-conf (:account-store stores-m))
-            email-authenticator (just-auth.messaging/->PasswordRecoverer email-conf (:password-recovery-store stores-m))
-            server             (-> (create-app config-m stores-m blockchain email-authenticator email-authenticator)
+            account-activator    (just-auth.messaging/->AccountActivator email-conf (:account-store stores-m))
+            password-recoverer (just-auth.messaging/->PasswordRecoverer email-conf (:password-recovery-store stores-m))
+            email-authenticator (just-auth.core/new-email-based-authentication
+                                 (select-keys stores-m [:account-store :password-recovery-store])
+                                 account-activator password-recoverer
+                                 {:hash-fn buddy.hashers/derive :hash-check-fn buddy.hashers/check})
+            server             (-> (create-app (assoc config-m
+                                                      :admin-email "aspra@dyne.org") stores-m blockchain email-authenticator)
                                    (server/run-server {:port (config/port config-m)
                                                        :host (config/host config-m)}))]
         (assoc app-state
@@ -223,7 +228,10 @@
                        blockchain         (blockchain/new-mongo stores-m)
                        account-activator (just-auth.messaging/->AccountActivator email-conf (:account-store stores-m))
                        password-recoverer (just-auth.messaging/->PasswordRecoverer email-conf (:password-recovery-store stores-m))
-                       email-authenticator (just-auth.core/new-email-based-authentication stores-m account-activator password-recoverer {:hash-fn buddy.hashers/derive :hash-check-fn buddy.hashers/check})]
+                       email-authenticator (just-auth.core/new-email-based-authentication
+                                            (select-keys stores-m [:account-store :password-recovery-store])
+                                            account-activator password-recoverer
+                                            {:hash-fn buddy.hashers/derive :hash-check-fn buddy.hashers/check})]
                    (prn "Restarting server....")
                    (create-app config-m stores-m blockchain email-authenticator)))))


Rename var json-key -> service-account

Rename var json-key -> service-account

--- src/googlica/auth.clj
+++ src/googlica/auth.clj
@@ -10,16 +10,16 @@

 ;;;; Key management

-(def ^:dynamic *json-key* nil)
+(def ^:dynamic *service-account* nil)

 (defn set-key!
-  "Updates the dynamic var *json-key* with the provided data"
+  "Updates the dynamic var *service-account* with the provided data"
   [new-key]
-  (alter-var-root #'*json-key* (constantly new-key)))
+  (alter-var-root #'*service-account* (constantly new-key)))

 (defn key-from-file
   "Given a file path containing the json service account key,
-  read it, convert it to a clojure map, and save it in the *json-key* var"
+  read it, convert it to a clojure map, and save it in the *service-account* var"
   [path]
   (-> (slurp path)
       (parse-string true)
@@ -38,8 +38,8 @@
 (defn sign-jwt
   "Given a scope string, generates a new signed JWT claim"
   [scope]
-  (let [privkey (keys/str->private-key (:private_key *json-key*))
-        claim {:iss (:client_email *json-key*)
+  (let [privkey (keys/str->private-key (:private_key *service-account*))
+        claim {:iss (:client_email *service-account*)
                :scope scope
                :aud access-request-url
                :exp (time/plus (time/now) (time/minutes 2))


https for images

https for images

--- Clojure-Websockets/MainApp/src/cljs/birdwatch/ui/tweets.cljs
+++ Clojure-Websockets/MainApp/src/cljs/birdwatch/ui/tweets.cljs
@@ -52,7 +52,7 @@
   (let [tweet ((memoize util/format-tweet) raw-tweet)
         user (:user tweet)
         screen-name (:screen_name user)
-        href (str "http://www.twitter.com/" screen-name)]
+        href (str "https://www.twitter.com/" screen-name)]
     [:div.tweet
      [:span [:a {:href href :target "_blank"} [:img.thumbnail{:src (:profile_image_url user)}]]]
      [:a {:href href :target "_blank"} [:span.username {:src (:profile_image_url user)} (:name user)]]