Fix failing test from refactoring

Fix failing test from refactoring

--- test/vindinium/test_bots.clj
+++ test/vindinium/test_bots.clj
@@ -31,12 +31,6 @@
    :viewUrl "http://vindinium.org/a2uvsc6n",
    :playUrl "http://vindinium.org/api/a2uvsc6n/lcjk/play"})
 (def sample-game (:game sample-state))
-
-(deftest test-state-accessors
-  (is (= [0 2] (state->hero-pos sample-state 1)))
-  (is (= [0 2] (state->own-pos sample-state))))
-
-

 (let [g {:heroes {1 {:pos [0 2] :spawnPos [0 0] :life 15 :gold 10 :mineCount 2}


Add explanatory comment to hooks defonce

--- src/braid/core/hooks.cljc
+++ src/braid/core/hooks.cljc
@@ -11,6 +11,7 @@
   (:require
     [braid.core.common.util :as util]))

+;; Atoms is a map of atoms to their initial values
 (defonce atoms (atom {}))

 (defn register!


fix test

fix test

--- resources/leiningen/new/closp/integtest/clj/web/admin.clj
+++ resources/leiningen/new/closp/integtest/clj/web/admin.clj
@@ -59,7 +59,7 @@

 (deftest ^:integration delete-user
   (sign-in)
-  (let [uname "_foo@bar.de"]
+  (let [uname "_aadmin@bar.de"]
     (->user uname)
     (click (find-element {:css "input.btn.btn-danger"}))
     (click (find-element {:css "input.btn.btn-danger"}))


Make modal appear for first 3 builds instead of just first build

--- src-cljs/frontend/experiments/no_test_intervention.cljs
+++ src-cljs/frontend/experiments/no_test_intervention.cljs
@@ -21,7 +21,7 @@

 (defn show-setup-docs-modal? [build]
   (and (show-intervention? build)
-       (-> build :build_num (= 1))))
+       (-> build :build_num (<= 3))))

 (defn- setup-docs-link-props [track-fn]
   (open-ext {:href "https://circleci.com/docs/manually"


Extract method get-hdrs-and-data-lines

Extract method get-hdrs-and-data-lines

--- src/cooljure/csv.clj
+++ src/cooljure/csv.clj
@@ -15,6 +15,15 @@
             [cooljure.misc              :as cool-misc]
             [cooljure.core              :refer :all] ))

+(defn get-hdrs-and-data-lines
+  [opts parsed-lines]
+  (if (:hdrs opts)  ; if user supplied col header keywords
+    { :hdrs-kw      (:hdrs opts)    ; use them
+      :data-lines   parsed-lines }  ; all lines are data
+  ;else, get col headers from first row -> keywords
+    { :hdrs-kw      (mapv cool-misc/str->kw (first parsed-lines))
+      :data-lines   (rest parsed-lines) } ))  ; rest of lines are data
+
 ; AWTAWT TODO: change csv-lines to allow line-seq
 (defn parse-csv->row-maps
  "[csv-lines & {:as opts} ]
@@ -30,16 +39,12 @@
   [csv-lines & {:as opts} ]
   { :pre  [ (string? csv-lines) ]
     :post [ (map? (first %)) ] }
-  (let [opts-def    (merge {:delimiter \,} opts)
-        data-lines  (apply csv/parse-csv csv-lines (keyvals opts-def))
-        ctx         (if (:hdrs opts)  ; if user supplied col header keywords
-                      { :hdrs-kw      (:hdrs opts)  ; use them
-                        :data-lines   data-lines }  ; all rows are data
-                    ;else, get col headers from first row -> keywords
-                      { :hdrs-kw      (mapv cool-misc/str->kw (first data-lines))
-                        :data-lines   (rest data-lines) } )  ; rest of rows are data
-        row-maps    (for [data-line (:data-lines ctx)]
-                      (zipmap (:hdrs-kw ctx) data-line) )
+  (let [opts-def        (merge {:delimiter \,} opts)
+        parsed-lines    (apply csv/parse-csv csv-lines (keyvals opts-def))
+        {:keys [hdrs-kw data-lines]}
+                        (get-hdrs-and-data-lines opts parsed-lines)
+        row-maps        (for [data-line data-lines]
+                          (zipmap hdrs-kw data-line) )
   ] row-maps ))

 ; AWTAWT TODO: clean up, enforce identical columns each row


fix drag transform property

fix drag transform property

--- src/chessground/drag.cljs
+++ src/chessground/drag.cljs
@@ -67,12 +67,12 @@
         transform (str "translate3d(" x "px, " y "px, 0)")]
     (set! (.-x piece) x)
     (set! (.-y piece) y)
-    (aset (.-style piece) common/transform-prop transform)))
+    (aset (.-style piece) transform-prop transform)))

 (defn- unfuck [piece]
   (set! (.-x piece) 0)
   (set! (.-y piece) 0)
-  (aset (.-style piece) common/transform-prop ""))
+  (aset (.-style piece) transform-prop ""))

 (defn- on-end [event chan]
   (let [piece (.-target event)
@@ -114,7 +114,7 @@
           dx (- (:left rect) (:left pos))
           dy (- (:top rect) (:top pos))]
       (aset (.-style dragging-div)
-            common/transform-prop (str "translate3d(" dx "px, " dy "px, 0)")))))
+            transform-prop (str "translate3d(" dx "px, " dy "px, 0)")))))

 (defn- on-touch-dragleave [] nil)


don't hardcode tc server url

don't hardcode tc server url

--- src/cion_clojure/core.clj
+++ src/cion_clojure/core.clj
@@ -3,23 +3,23 @@
   (:require [clj-http.client :as client])
   (:use [clojure.data.xml], [clojure.tools.cli :only [cli]]))

-(defn create-project [project-name]
-  (client/post "http://ivan:password@localhost:8080/httpAuth/app/rest/projects/"
+(defn create-project [project-name ci-server-url]
+  (client/post (str ci-server-url "/httpAuth/app/rest/projects")
   {:body project-name
    :content-type "text/plain"
    :accept :xml}))

-(defn create-projects [project-names]
-	(map create-project project-names))
+(defn create-projects [project-names ci-server-url]
+	(map create-project project-names ci-server-url))

 (defn extract-name [node]
 	(:name (:attrs node)))

-(defn project-names-xml []
-	(parse-str (:body (client/get "http://ivan:password@localhost:8080/httpAuth/app/rest/projects/"))))
+(defn project-names-xml [ci-server-url]
+	(parse-str (:body (client/get (str ci-server-url "/httpAuth/app/rest/projects")))))

-(defn get-project-names []
-	(map extract-name (:content (project-names-xml))))
+(defn get-project-names [ci-server-url]
+	(map extract-name (:content (project-names-xml ci-server-url))))

 (defn quoted [s]
 	(str "\"" s "\""))
@@ -36,7 +36,7 @@
 		(def command-line-values
 			(first command-line-options))
 		(if (= (:file command-line-values) "")
-			(println (str "(create-projects (list " (clojure.string/join " " (map quoted (get-project-names))) "))"))
+			(println (str "(create-projects (list " (clojure.string/join " " (map quoted (get-project-names (:url command-line-values)))) "))"))
 			(print command-line-values))
 	)
   )


CMR-3203 Update to dos and comments

CMR-3203 Update to dos and comments

--- search-app/src/cmr/search/services/humanizers_service.clj
+++ search-app/src/cmr/search/services/humanizers_service.clj
@@ -27,7 +27,8 @@
 (defn- get-all-collections
   "Retrieves all collections from the Metadata cache"
   [context]
-  ;; TODO should this throw an exception if the cache isn't populated
+  ;; Currently not throwing an exception if the cache is empty. May want to change in the future
+  ;; to throw an exception.
   ;; TODO should this use pmap? (Test performance in workload and then look at times if too slow.)
   (map #(rfm->umm-collection context %) (metadata-cache/all-cached-revision-format-maps context)))

@@ -62,7 +63,6 @@
 (defn humanizers-report-csv
   "Returns a report on humanizers in use in collections as a CSV."
   [context]
-  ;; TODO add logging of times taken for each step. See Metadata Cache functions for examples of how we do that.
   (let [[t1 collections] (u/time-execution
                           (get-all-collections context))
         [t2 humanized-rows] (u/time-execution


Added missing :form keys

Added missing :form keys

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -901,7 +901,7 @@
             block))))

 (defmethod parse 'fn*
-  [op env [_ & args] name]
+  [op env [_ & args :as form] name]
   (let [[name meths] (if (symbol? (first args))
                        [(first args) (next args)]
                        [name (seq args)])
@@ -915,14 +915,14 @@
         max-fixed-arity (apply max (map :max-fixed-arity methods))
         variadic (boolean (some :variadic methods))]
     ;;todo - validate unique arities, at most one variadic, variadic takes max required args
-    {:env env :op :fn :name mname :methods methods :variadic variadic
+    {:env env :op :fn :form form :name mname :methods methods :variadic variadic
      :recur-frames *recur-frames* :loop-lets *loop-lets*
      :jsdoc [(when variadic "@param {...*} var_args")]
      :max-fixed-arity max-fixed-arity}))

 (defmethod parse 'do
-  [op env [_ & exprs] _]
-  (merge {:env env :op :do} (analyze-block env exprs)))
+  [op env [_ & exprs :as form] _]
+  (merge {:env env :op :do :form form} (analyze-block env exprs)))

 (defn analyze-let
   [encl-env [_ bindings & exprs :as form] is-loop]
@@ -965,13 +965,13 @@
   (analyze-let encl-env form true))

 (defmethod parse 'recur
-  [op env [_ & exprs] _]
+  [op env [_ & exprs :as form] _]
   (let [context (:context env)
         frame (first *recur-frames*)]
     (assert frame "Can't recur here")
     (assert (= (count exprs) (count (:names frame))) "recur argument count mismatch")
     (reset! (:flag frame) true)
-    (assoc {:env env :op :recur}
+    (assoc {:env env :op :recur :form form}
       :frame frame
       :exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs))))))

@@ -980,15 +980,15 @@
   {:op :constant :env env :form x})

 (defmethod parse 'new
-  [_ env [_ ctor & args] _]
+  [_ env [_ ctor & args :as form] _]
   (disallowing-recur
    (let [enve (assoc env :context :expr)
          ctorexpr (analyze enve ctor)
          argexprs (vec (map #(analyze enve %) args))]
-     {:env env :op :new :ctor ctorexpr :args argexprs})))
+     {:env env :op :new :form form :ctor ctorexpr :args argexprs})))

 (defmethod parse 'set!
-  [_ env [_ target val alt] _]
+  [_ env [_ target val alt :as form] _]
   (let [[target val] (if alt
                        ;; (set! o -prop val)
                        [`(. ~target ~val) alt]
@@ -1019,10 +1019,10 @@
        (assert targetexpr "set! target must be a field or a symbol naming a var")
        (cond
         (= targetexpr ::set-unchecked-if) {:env env :op :no-op}
-        :else {:env env :op :set! :target targetexpr :val valexpr})))))
+        :else {:env env :op :set! :form form :target targetexpr :val valexpr})))))

 (defmethod parse 'ns
-  [_ env [_ name & args] _]
+  [_ env [_ name & args :as form] _]
   (let [excludes
         (reduce (fn [s [k exclude xs]]
                   (if (= k :refer-clojure)
@@ -1062,11 +1062,11 @@
                                      (into {} (map (fn [[alias nsym]]
                                                      [alias (find-ns nsym)])
                                                    requires-macros)))))
-    {:env env :op :ns :name name :uses uses :requires requires
+    {:env env :op :ns :form form :name name :uses uses :requires requires
      :uses-macros uses-macros :requires-macros requires-macros :excludes excludes}))

 (defmethod parse 'deftype*
-  [_ env [_ tsym fields] _]
+  [_ env [_ tsym fields :as form] _]
   (let [t (munge (:name (resolve-var (dissoc env :locals) tsym)))]
     (swap! namespaces update-in [(-> env :ns :name) :defs tsym]
            (fn [m]
@@ -1076,10 +1076,10 @@
                      (assoc :file *cljs-file*)
                      (assoc :line line))
                  m))))
-    {:env env :op :deftype* :t t :fields fields}))
+    {:env env :op :deftype* :as form :t t :fields fields}))

 (defmethod parse 'defrecord*
-  [_ env [_ tsym fields] _]
+  [_ env [_ tsym fields :as form] _]
   (let [t (munge (:name (resolve-var (dissoc env :locals) tsym)))]
     (swap! namespaces update-in [(-> env :ns :name) :defs tsym]
            (fn [m]
@@ -1089,7 +1089,7 @@
                      (assoc :file *cljs-file*)
                      (assoc :line line))
                  m))))
-    {:env env :op :defrecord* :t t :fields fields}))
+    {:env env :op :defrecord* :form form :t t :fields fields}))

 ;; dot accessor code

@@ -1160,17 +1160,17 @@
   (throw (Error. (str "Unknown dot form of " (list* '. dot-form) " with classification " (classify-dot-form dot-form)))))

 (defmethod parse '.
-  [_ env [_ target & [field & member+]] _]
+  [_ env [_ target & [field & member+] :as form] _]
   (disallowing-recur
    (let [{:keys [dot-action target method field args]} (build-dot-form [target field member+])
          enve        (assoc env :context :expr)
          targetexpr  (analyze enve target)]
      (case dot-action
-           ::access {:env env :op :dot
+           ::access {:env env :op :dot :form form
                      :target targetexpr
                      :field field}
            ::call   (let [argexprs (map #(analyze enve %) args)]
-                      {:env env :op :dot
+                      {:env env :op :dot :form form
                        :target targetexpr
                        :method method
                        :args argexprs})))))
@@ -1197,11 +1197,11 @@
                        (let [end (.indexOf s "}" idx)
                              inner (:name (resolve-existing-var env (symbol (subs s (+ 2 idx) end))))]
                          (cons (subs s 0 idx) (cons inner (interp (subs s (inc end)))))))))]
-      {:env env :op :js :code (apply str (interp jsform))
+      {:env env :op :js :form form :code (apply str (interp jsform))
        :tag (-> form meta :tag)})))

 (defn parse-invoke
-  [env [f & args]]
+  [env [f & args :as form]]
   (disallowing-recur
    (let [enve (assoc env :context :expr)
          fexpr (analyze enve f)
@@ -1214,7 +1214,7 @@
                         (and variadic (< argc max-fixed-arity))))
            (warning env
              (str "WARNING: Wrong number of args (" argc ") passed to " name)))))
-     {:env env :op :invoke :f fexpr :args argexprs
+     {:env env :op :invoke :form form :f fexpr :args argexprs
       :tag (-> fexpr :info :tag)})))

 (defn analyze-symbol


Reformulated the docstring

Reformulated the docstring

--- src/cljs/drawer/util.cljs
+++ src/cljs/drawer/util.cljs
@@ -3,8 +3,9 @@
             [tailrecursion.cljson :refer [clj->cljson cljson->clj]]))

 (defn update-values
-  "Updates the values of given map using
-  given function with given arguments."
+  "Updates the map 'm' by applying
+  the function 'f' with the
+  arguments 'args' to every value."
   [m f & args]
   (reduce (fn [r [k v]] (assoc r k (apply f v args))) {} m))


some more code makeup

some more code makeup

--- src/cljs/gaugin/core.cljs
+++ src/cljs/gaugin/core.cljs
@@ -40,50 +40,51 @@
   [data frame]
   (let [width 1080
         height 920
-        tree (-> d3 .-layout .tree (.size [(- height 50) width]))
-        diagonal (-> d3 .-svg .diagonal (.projection #(clj->js [(* 0.6 (.-x %)) (* 0.6 (.-y %))])))
-        svg (-> d3 (.select frame)
-                (.attr {:width width :height height})
-                (.append "g")
-                (.attr {:transform (str "translate(" (/ width 4) ",20)")}))
+        tree (.. d3 -layout tree (size [(- height 50) width]))
+        diagonal (.. d3 -svg diagonal (projection #(clj->js [(* 0.6 (.-x %)) (* 0.6 (.-y %))])))
+        svg (.. d3
+                (select frame)
+                (attr {:width width :height height})
+                (append "g")
+                (attr {:transform (str "translate(" (/ width 4) ",20)")}))
         nodes (.nodes tree data)
         links (.links tree nodes)
-        link (-> svg
-              (.selectAll "path.link")
-              (.data links)
-              .enter
-              (.append "path")
-              (.attr {:class "link"
+        link (.. svg
+              (selectAll "path.link")
+              (data links)
+              enter
+              (append "path")
+              (attr {:class "link"
                       :d diagonal}))
-        node (-> svg
-              (.selectAll "g.node")
-              (.data nodes)
-              (.enter)
-              (.append "g")
-              (.attr {:class "node"
+        node (.. svg
+              (selectAll "g.node")
+              (data nodes)
+              enter
+              (append "g")
+              (attr {:class "node"
                       :transform #(str "translate(" (* 0.6 (.-x %)) "," (* 0.6 (.-y %)) ")")}))]
     (do
-      (-> node
-          (.append "circle")
-          (.attr {:r 4.5}))
-      (-> node
-          (.append "text")
-          (.attr {:dx 3
+      (.. node
+          (append "circle")
+          (attr {:r 4.5}))
+      (.. node
+          (append "text")
+          (attr {:dx 3
                   :dy #(if (.-children %) -8 8)
                   :text-anchor #(if (.-children %) "end" "start")})
-          (.style {:font-size "10px"})
-          (.text #(.-name %)))
-      (-> d3
-          (.select (.-frameElement js/self))
-          (.style {:height (str (- height 50) "px")
+          (style {:font-size "10px"})
+          (text #(.-name %)))
+      (.. d3
+          (select (.-frameElement js/self))
+          (style {:height (str (- height 50) "px")
                    :width (str width "px")})))))

 (defn clear-canvas [frame]
-  (-> d3
-      (.select frame)
-      (.select "svg")
-      .remove))
+  (.. d3
+      (select frame)
+      (select "svg")
+      remove))

 (defn draw-fdg


Add note about update branch bug

Add note about update branch bug

--- src/all/cider_ci/server/projects/repositories/git_sql.clj
+++ src/all/cider_ci/server/projects/repositories/git_sql.clj
@@ -255,6 +255,7 @@
          :current_commit_id commit-id}))))

+; TODO update branch doesn't work yet
 ; TODO change to import-or-update-branches
 ; see also related code update_branches_commits in the old code
 (defn import-branches [project]


Fix bug on recent colors finder.

Fix bug on recent colors finder.

--- src/uxbox/ui/workspace/recent_colors.cljs
+++ src/uxbox/ui/workspace/recent_colors.cljs
@@ -27,10 +27,10 @@

 (defn- calculate-colors
   [shapes]
-  (as-> (comp
-         #(count-color %1 %2 :fill)
-         #(count-color %1 %2 :stroke)) $
-    (reduce $ {} shapes)
+  (as-> {} $
+    (reduce #(count-color %1 %2 :fill) $ shapes)
+    (reduce #(count-color %1 %2 :stroke) $ shapes)
+    (remove nil? $)
     (sort-by second (into [] $))
     (take 5 (map first $))))


more docstrings added/edits to docstrings

--- src/vip/data_processor/validation/csv.clj
+++ src/vip/data_processor/validation/csv.clj
@@ -85,9 +85,10 @@
   `do-bulk-import-and-validate-csv`) and transforms (see
   `data-spec/translation-fns` in
   `do-bulk-import-and-validate-csv`). Inserts the row into the
-  database, and records any UNIQUE constraint-failing SQLExceptions as
-  errors. Returns the context `ctx`. If the supplied chunk is empty,
-  simply returns the context as-is."
+  database, retries any UNIQUE id constraint-failing SQLExceptions
+  removing ids, and marks others as errors. Returns the context
+  `ctx`. If the supplied chunk is empty, simply returns the context
+  as-is."
   [{:keys [columns filename] :as data-spec}
    {:keys [transforms column-names headers sql-table line-number] :as file-ctx}
    ctx chunk]
@@ -140,6 +141,8 @@
   (->> reader .readLine csv/read-csv first))

 (defn warn-if-extraneous-headers
+  "Records an error if headers are present in the file that do not
+  correspond to any in the data-spec (`column-names`)."
   [ctx {:keys [table] :as data-spec} headers column-names]
   (let [extraneous-headers (seq (set/difference (set headers) (set column-names)))]
     (if extraneous-headers
@@ -149,6 +152,9 @@
       ctx)))

 (defn file-handle->string-keys
+  "Given a file handle, returns a collection of cleaned (of non word
+  characters), lower-cased string keys for the first line, assumed to
+  be the header row."
   [file-handle]
   (->> file-handle
        read-one-line
@@ -156,6 +162,9 @@
        (map str/lower-case)))

 (defn required-header-names
+  "Given a collection of column maps, returns cleaned (of non word
+  characters), lower-cased string names (:name) of all the columns
+  which are required (:required)."
   [columns]
   (-> (comp (filter :required)
             (map :name)
@@ -168,7 +177,10 @@
   preliminary validation of CSV data using the chunking mechanism in
   vip.data-processor.db.util/chunk-rows. Returns the context `ctx`
   having performed all necessary database insertions, error reporting,
-  and other preliminary validation."
+  and other preliminary validation.
+
+  Records an error if there are extraneous header columns or no
+  overlap between the file headers and the data-spec column-names."
   [{:keys [data-specs tables] :as ctx}
    {:keys [filename table columns] :as data-spec}
    in-file]


A basic denoising auto-encoder.

A basic denoising auto-encoder.

--- src/diabolo/core.clj
+++ src/diabolo/core.clj
@@ -43,25 +43,25 @@

 (defn encoder
-  [{:keys [input-size hidden-size encoder-activation sparsity-weight sparsity-target dropout] :as config}]
+  [{:keys [input-size hidden-size max-weights encoder-activation sparsity-weight sparsity-target dropout] :as config}]
   (stack
     ;;(offset :length input-size :delta -0.5)
     (neural-network :inputs input-size
                     :outputs hidden-size
                     :layers 1
-                    :max-weight-length 7.0
+                    :max-weight-length max-weights
                     :output-op encoder-activation
                     :dropout dropout)
     (sparsifier :length hidden-size :weight sparsity-weight)))

 (defn decoder
-  [{:keys [input-size hidden-size decoder-activation] :as config}]
+  [{:keys [input-size hidden-size max-weights decoder-activation] :as config}]
   (stack
     ;(offset :length hidden-size :delta -0.5)
     (neural-network :inputs hidden-size
                     :outputs input-size
-                    ;; :max-weight-length 4.0
+                    :max-weight-length max-weights
                     :output-op decoder-activation
                     :layers 1)))

@@ -189,7 +189,7 @@
         mlp    (classifier config ae)
         evaluator (evaluator-task config mlp)]

-    (view-samples 25 train-data)
+    (view-samples n-reconstructions train-data)

     (println "Training autoencoder...")
     (task/run {:repeat true}
@@ -231,13 +231,14 @@
   {:input-size      784
    :hidden-size     1000
    :classifier-size 200
-   :noise-pct       0.2
-   :dropout         0.3
-   :sparsity-weight 0.2
-   :sparsity-target 0.05
-   :encoder-activation Ops/TANH
-   :decoder-activation Ops/TANH
-   :learning-rate 0.0005
+   :max-weights     2.0
+   :noise-pct       0.5
+   :dropout         0.0
+   :sparsity-weight 0.1
+   :sparsity-target 0.2
+   :encoder-activation Ops/LOGISTIC ;Ops/RECTIFIER
+   :decoder-activation Ops/LOGISTIC ;Ops/RECTIFIER
+   :learning-rate 0.001

    :classes       MNIST-CLASSES
    :train-data    MNIST-DATA


Fix `scroll-to-node!` in Firefox.

Fix `scroll-to-node!` in Firefox.

Firefox doesn't scroll the `body`, it scrolls the `html`. Google Closure
can tell us which element we want to be scrolling.

--- src-cljs/frontend/utils.cljs
+++ src-cljs/frontend/utils.cljs
@@ -260,15 +260,15 @@

 (defn scroll-to-node!
   [node]
-  (let [body (.-body js/document)
+  (let [scrolling-element (dom/getDocumentScrollElement)
         node-top (style/getPageOffsetTop node)
-        body-top (style/getPageOffsetTop body)
+        current-top (style/getPageOffsetTop scrolling-element)
         header-height (if-let [navbar (dom/getElementByClass "navbar-fixed-top")]
                         (+ (js/parseFloat (style/getComputedStyle navbar "marginTop"))
                            (.-offsetHeight navbar)
                            (js/parseFloat (style/getComputedStyle navbar "marginBottom")))
                         0)]
-    (set! (.-scrollTop body) (- node-top body-top header-height))))
+    (set! (.-scrollTop scrolling-element) (- node-top current-top header-height))))

 (defn scroll-to-id!
   "Scrolls to the element with given id, if node exists"


Checkpoint

Checkpoint

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/build/interface.clj
+++ src/obcc/build/interface.clj
@@ -68,17 +68,29 @@
         (recur (zip/right loc) (assoc fields (:index attrs) attrs))))))

 ;;-----------------------------------------------------------------
+;; manage object names
+;;-----------------------------------------------------------------
+(defn qualifyname [base name]
+  (str base "_" name))
+
+;; scalar types should just be passed naked.  user types should be fully qualified
+(defn typeconvert [basename [type name]]
+  (if (= type :scalar)
+      name
+      (qualifyname basename name)))
+
+;;-----------------------------------------------------------------
 ;; buildX - build our ST friendly objects from the AST
 ;;-----------------------------------------------------------------
-(defn buildfields [ast]
+(defn buildfields [basename ast]
   (let [rawfields (getfields ast)]
     (into {} (map (fn [[index {:keys [modifier type fieldName]}]]
-                    (vector index (->Field modifier (let [[_ _type] type] _type) fieldName index))) rawfields))))
+                    (vector index (->Field modifier (typeconvert basename type) fieldName index))) rawfields))))

-(defn buildmessage [fqname ast]
+(defn buildmessage [basename ast]
   (let [name (->> ast zip/right zip/node)
-        fields (buildfields (->> ast zip/right zip/right))]
-    (->Message (str fqname "_" name) fields)))
+        fields (buildfields basename (->> ast zip/right zip/right))]
+    (->Message (qualifyname basename name) fields )))

 (defn buildmessages [fqname ast]
   (loop [loc ast msgs '()]


Fixed issue #39

Fixed issue #39

--- src/alfresco_technical_validation/alfresco_public_api.clj
+++ src/alfresco_technical_validation/alfresco_public_api.clj
@@ -22,7 +22,7 @@

 (def ^:private ^String api-page-url       "http://docs.alfresco.com/4.2/topic/com.alfresco.enterprise.doc/concepts/java-public-api-list.html")
-(def ^:private ^String api-list-open-tag  "
")
+(def ^:private ^String api-list-open-tag  "
")
 (def ^:private ^String api-list-close-tag "
")

 (defn public-java-api


fix rename of detail to election

fix rename of detail to election

--- src/cljs/early_vote_site/early_vote_site_form/events.cljs
+++ src/cljs/early_vote_site/early_vote_site_form/events.cljs
@@ -54,7 +54,7 @@

 (defn create-params [db]
   (let [form (form->params (:early-vote-site-form db))
-        fips (get-in db [:election-detail :detail :state-fips])
+        fips (get-in db [:election-detail :election :state-fips])
         state (get constants/state-abbreviations-by-fips fips)]
     (merge form {:state state})))


change app model search-id to be more descriptive of params

--- pedestal-app/app/src/semtag_web/route.clj
+++ pedestal-app/app/src/semtag_web/route.clj
@@ -25,7 +25,10 @@

 ;; may eventually be in it's own namespace
 (defn create-screen-id [seed params]
-  (keyword (str (name seed) "-" (hash (sorted-map params)))))
+  (keyword (str (name seed) "-"
+                (string/join "_"
+                             (map #(str (-> % key name) "_"  (val %))
+                                  (->> params (reduce into) (apply sorted-map)))))))

 (defn url->screen
   ([url] (url->screen url {}))


deleting resets a comment cache

deleting resets a comment cache

--- src/ontrail/newcomment.clj
+++ src/ontrail/newcomment.clj
@@ -16,11 +16,11 @@
      ((alter users-cache assoc user (ref {})) user))))

 (defn newcount-get-new [user id]
-  (dosync
-   (let [user-cache (get-newcount user)]
-     (if (and (not= nil user-cache) (contains? @user-cache id))
-       (:c (@user-cache id))
-       0))))
+  (let [user-cache (get-newcount user)]
+    (.info logger (str "User " user " cache " (:c (@user-cache id) )))
+    (if (and (not= nil user-cache) (contains? @user-cache id))
+      (:c (@user-cache id))
+      0)))

 (defn newcount-reset [user id]
   (dosync
@@ -39,7 +39,6 @@
        (alter user-newcount-ref assoc id {:ts now :c 1})))))

 (defn newcount-cache-inc [id user] (newcount-cache-mod + id user))
-(defn newcount-cache-dec [id user] (newcount-cache-mod - id user))

 (defn zero-cache [id] 0)

@@ -50,8 +49,8 @@

 (defn newcount-comment-ex [id]
   (let [users (mc/distinct ONUSER "username" {})]
-    (future (.debug logger (str "Comment cache increment. Distributed to: " (count (map (partial newcount-cache-inc id) users)))))))
+    (future (.debug logger (str "Comment cache increment " id ". Distributed to: " (count (map (partial newcount-cache-inc id) users)))))))

 (defn newcount-uncomment-ex [id]
   (let [users (mc/distinct ONUSER "username" {})]
-    (future (.debug logger (str "Comment cache decrement. Distributed to: " (count (map (partial newcount-cache-dec id) users)))))))+    (future (.debug logger (str "Comment cache reset. " id "Distributed to: " (count (map #(newcount-reset % id) users)))))))


fix classpath JS hot reload

fix classpath JS hot reload

wasn't using the correct pseudo-ns for .js files

--- src/main/shadow/cljs/devtools/server/reload_classpath.clj
+++ src/main/shadow/cljs/devtools/server/reload_classpath.clj
@@ -10,7 +10,8 @@
     [shadow.cljs.model :as m]
     [shadow.cljs.util :as util]
     [shadow.build.resource :as rc]
-    [shadow.build.macros :as bm]))
+    [shadow.build.macros :as bm])
+  (:import [com.google.javascript.jscomp.deps ModuleNames]))

 ;; FIXME: rewrite this similar to npm-update so that it only checks files that are actually used
 ;; checking all source paths all the time is overkill
@@ -44,7 +45,9 @@
         ns-updates
         (reduce
           (fn [result {:keys [event name]}]
-            (let [ns (util/filename->ns name)]
+            (let [ns (if (util/is-cljs-file? name)
+                       (util/filename->ns name)
+                       (symbol (ModuleNames/fileToModuleName name)))]
               (-> result
                   (update :namespaces conj ns)
                   (update event conj ns))))


fix request emails for team docs

fix request emails for team docs

--- src/pc/email.clj
+++ src/pc/email.clj
@@ -144,7 +144,18 @@
   (let [requester (:access-request/cust-ref access-request)
         doc (:access-request/document-ref access-request)
         doc-id (:db/id doc)
-        doc-owner (cust-model/find-by-uuid db (:document/creator doc))]
+        doc-owner (cond (:document/creator doc)
+                        (cust-model/find-by-uuid db (:document/creator doc))
+
+                        (:document/team doc)
+                        (->> (:document/team doc)
+                          (permission-model/find-by-team db)
+                          (filter :permission/cust-ref)
+                          (sort-by :permission/grant-date)
+                          first
+                          :permission/cust-ref)
+
+                        :else (throw+ {:error :no-doc-owner :msg (format "Nobody owns the doc %s" doc-id)}))]
     (ses/send-message {:from (view/email-address "Precursor" "joinme")
                        :to (:cust/email doc-owner)
                        :subject (str (view/format-requester requester)


Rewrite thing->prior-versions with a multimethod

Because some API platforms may be able to provide more efficient
implementations and it'd be nice to allow that.

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -346,6 +346,10 @@
   [config thing]
   {:pre [(t/versioned? thing)
          (not (t/leaf? thing))]}
+  (-thing->prior-versions config thing))
+
+(defmethod -thing->prior-versions :default
+  [config thing]
   (match thing
     ;; Case of a Version
     ;;


Scope maybe?

Scope maybe?

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -58,20 +58,20 @@
   (when-let [filepath (:file (meta v))]
     (when-let [strm (.getResourceAsStream (clojure.lang.RT/baseLoader) filepath)]
       (with-open [rdr (java.io.LineNumberReader. (java.io.InputStreamReader. strm))]
-        (dotimes [_ (dec (:line (meta v)))]
-          (.readLine rdr))
-        (let [text (StringBuilder.)
-              pbr  (proxy [java.io.PushbackReader] [rdr]
-                     (read [] (let [i (proxy-super read)]
-                                (.append text (char i))
-                                i)))]
-          (if (= :unknown *read-eval*)
-            (throw
-             (IllegalStateException.
-              "Unable to read source while *read-eval* is :unknown."))
-            (binding [*ns* (the-ns (var->ns v))]
-              (read (java.io.PushbackReader. pbr))))
-          (str text))))))
+        (binding [*ns* (.ns v)]
+          (dotimes [_ (dec (:line (meta v)))]
+            (.readLine rdr))
+          (let [text (StringBuilder.)
+                pbr  (proxy [java.io.PushbackReader] [rdr]
+                       (read [] (let [i (proxy-super read)]
+                                  (.append text (char i))
+                                  i)))]
+            (if (= :unknown *read-eval*)
+              (throw
+               (IllegalStateException.
+                "Unable to read source while *read-eval* is :unknown."))
+              (read (java.io.PushbackReader. pbr)))
+            (str text)))))))

 (defn ns-stringifier


Added row/col functions

Added row/col functions

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -17,19 +17,87 @@
        (str/split-lines )
        (map str/trim ) ))

-(def len-word-map
-  "Each key is a word length. Each value is a collection of all words of that length. Some
-  keys may be absent if no words of that length are present."
+(def words-by-length
+  "Maps word length to word values.  Each key is a word length. Each value is a collection
+  of all words of that length.  Keys are absent if no words of that length are present."
   (group-by count all-words) )

-(def max-len
+(def max-word-length
   "The maximum length of any word."
-  (apply max (keys len-word-map)) )
+  (apply max (keys words-by-length)) )
+
+(defn to-word-array
+  "Returns all words of the specified length as a 2D array (vector of vectors).
+  First index selects a given word, 2nd index selects chars from that word."
+  [word-length]
+  { :pre  [ (integer? word-length) ]
+    :post [ (vector? %) ] }
+  (vec
+    (map vec (words-by-length word-length)) ))
+
+(defn get-array-column
+  "Given a 2D array (vector of vectors), return a vector of elements
+  from the specified column."
+  [word-array col-idx]
+  { :pre  [ (integer? col-idx) ]
+    :post [ (vector? %) ] }
+  (reduce #(conj %1 (%2 col-idx))
+          [] word-array ) )
+
+(defn get-array-row
+  "Given a 2D array (vector of vectors), return a vector of elements
+  from the specified row."
+  [word-array row-idx]
+  { :pre  [ (integer? row-idx) ]
+    :post [ (vector? %) ] }
+  (word-array row-idx) )
+
+(defn run-tests []
+  ; Manipulation of strings/vectors/character seq's
+  (assert (= (vec "abcd")                [\a \b \c \d] ))
+  (assert (= (str/join  (vec "abcd"))    "abcd" ))
+  (assert (= (apply str (vec "abcd"))    "abcd" ))
+
+  (let [ tstArr [ [:a :b :c] [1 2 3] [\a \b \c]] ]
+    (assert (= (get-array-row    tstArr 0) [:a :b :c] ))
+    (assert (= (get-array-row    tstArr 1) [ 1  2  3] ))
+    (assert (= (get-array-row    tstArr 2) [\a \b \c] ))
+    (assert (= (get-array-column tstArr 0) [:a  1 \a] ))
+    (assert (= (get-array-column tstArr 1) [:b  2 \b] ))
+    (assert (= (get-array-column tstArr 2) [:c  3 \c] ))
+  )
+
+  ; Use of (frequencies...) and (merge-with...)
+  (assert (= (frequencies "abbccc")
+             {\a 1, \b 2, \c 3} ))
+  (assert (= (frequencies ["abc" "bc" "c"])
+             {"abc" 1 "bc" 1 "c" 1} ))
+  (assert (= (map frequencies ["abc" "bc" "c"])
+             [ {\a 1, \b 1, \c 1} {\b 1, \c 1} {\c 1} ] ))
+  (assert (= (apply merge-with + (map frequencies ["abc" "bc" "c"]) )
+             {\a 1 \b 2 \c 3} ))
+)
+
+(defn words-of-length
+  "Returns a seq of words of the specified length."
+  [word-length]
+  { :pre  [ (integer? word-length) ]
+    :post [ ] }
+  (get words-by-length word-length [] ) )
+
+; (def data-map
+;   "A map of data keyed by word length"
+;   (doseq [curr-len (range 4 (inc 4)) ]
+;     (apply merge-with +
+;       (map frequencies (words-of-length curr-len)) )))

 (defn main []
   (println "main: enter")
+  (run-tests)
   (show-info all-words "all-words")
-  (doseq [ curr-len (range 1 (inc max-len)) ]
-    (let [ curr-words   (get len-word-map curr-len [] ) ]
-      (show-info curr-words (str "len=" curr-len) ) )
-  ) )
+  (doseq [ curr-len    (range 1 (inc max-word-length)) ]
+    (show-info (words-of-length curr-len) (str "len=" curr-len) ) )
+)
+
+(defonce sanity-check (run-tests) )
+


Customized output and correct error in context-{sub,ap}position

Now contexts can be printed via print-context, which takes a context and
two sorting functions for objects and attributes respectively.

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

--- conexp/fca/contexts.clj
+++ conexp/fca/contexts.clj
@@ -22,25 +22,40 @@
 (defn incidence [ctx]
   ((.state ctx) :incidence))

+(defn sort-by-second [x y]
+  (cond
+    (and (vector? x)
+	 (vector? y)
+	 (= 2 (count x) (count y)))
+    (if (= (second x) (second y))
+      (< (first x) (first y))
+      (< (second x) (second y)))
+    :else
+    (< x y)))
+
+(defn print-context [ctx order-on-objects order-on-attributes]
+  (let [attributes (vec (sort order-on-objects (attributes ctx)))
+	objects    (vec (sort order-on-attributes (objects ctx)))
+	incidence  (incidence ctx)
+
+	max-att (reduce #(max %1 (count (str %2))) 0 attributes)
+	max-obj (reduce #(max %1 (count (str %2))) 0 objects)]
+    (with-str-out
+      "\n"
+      (ensure-length "" max-obj " ") " |" (for [att attributes] [(str att) " "]) "\n"
+      (ensure-length "" max-obj "-") "-+" (for [att attributes]
+					    (ensure-length "" (inc (count (str att))) "-")) "\n"
+      (for [obj objects]
+	[ (ensure-length (str obj) max-obj)
+	  " |"
+	  (for [att attributes]
+	    [ (ensure-length (if (incidence [obj att]) "x" ".")
+			     (count (str att)))
+	      " "])
+	  "\n" ]))))
+
 (defn Context-toString [this]
-  (let [objects    (vec ((.state this) :objects))
-	attributes (vec ((.state this) :attributes))
-	incidence  ((.state this) :incidence)]
-    (let [max-att (reduce #(max %1 (count (str %2))) 0 attributes)
-	  max-obj (reduce #(max %1 (count (str %2))) 0 objects)]
-      (with-str-out
-	"\n"
-	(ensure-length "" max-obj " ") " |" (for [att attributes] [(str att) " "]) "\n"
-	(ensure-length "" max-obj "-") "-+" (for [att attributes]
-					      (ensure-length "" (inc (count (str att))) "-")) "\n"
-	(for [obj objects]
-	  [ (ensure-length (str obj) max-obj)
-	    " |"
-	    (for [att attributes]
-	      [ (ensure-length (if (incidence [obj att]) "x" ".")
-			       (count (str att)))
-		" "])
-	    "\n" ])))))
+  (print-context this sort-by-second sort-by-second))

 (defn Context-equals [this other]
   (and (instance? conexp.fca.Context other)
@@ -192,7 +207,8 @@
      (IllegalArgumentException. (str "Cannot do context apposition, since object sets are not equal."))))
   (let [new-atts (union (set-of [m 1] [m (attributes ctx-1)])
 			(set-of [m 2] [m (attributes ctx-2)]))
-	new-inz  (union (incidence ctx-1) (incidence ctx-2))]
+	new-inz  (union (set-of [g [m 1]] [[g m] (incidence ctx-1)])
+			(set-of [g [m 2]] [[g m] (incidence ctx-2)]))]
     (make-context (objects ctx-1) new-atts new-inz)))

 (defn context-subposition [ctx-1 ctx-2]
@@ -201,7 +217,8 @@
      (IllegalArgumentException. (str "Cannot do context subposition, since attribute sets are not equal."))))
   (let [new-objs (union (set-of [g 1] [g (objects ctx-1)])
 			(set-of [g 2] [g (objects ctx-2)]))
-	new-inz  (union (incidence ctx-1) (incidence ctx-2))]
+	new-inz  (union (set-of [[g 1] m] [[g m] (incidence ctx-1)])
+			(set-of [[g 2] m] [[g m] (incidence ctx-2)]))]
     (make-context new-objs (attributes ctx-1) new-inz)))

 (defn transitive-closure
@@ -230,4 +247,23 @@
   (make-context base-set base-set =))

 (defn adiag-context [base-set]
-  (make-context base-set base-set not=))+  (make-context base-set base-set not=))
+
+;;;
+
+(defn context-sum [ctx-1 ctx-2]
+  (let [new-objs (union (set-of [g_1 1] [g_1 (objects ctx-1)])
+			(set-of [g_2 2] [g_2 (objects ctx-2)]))
+	new-atts (union (set-of [m_1 1] [m_1 (attributes ctx-1)])
+			(set-of [m_2 2] [m_2 (attributes ctx-2)]))
+	new-inz  (union (set-of [[g_1 1] [m_1 1]]
+				[[g_1 m_1] (incidence ctx-1)])
+			(set-of [[g_2 2] [m_2 2]]
+				[[g_2 m_2] (incidence ctx-2)])
+			(set-of [[g_1 1] [m_2 2]]
+				[g_1 (objects ctx-1)
+				 m_2 (attributes ctx-2)])
+			(set-of [[g_2 2] [m_1 1]]
+				[g_2 (objects ctx-2)
+				 m_1 (attributes ctx-1)]))]
+    (make-context new-objs new-atts new-inz)))


Reduce CPU usage by sleeping a bit between each poll

--- src/rpi_challenger/app.clj
+++ src/rpi_challenger/app.clj
@@ -58,6 +58,9 @@
       (if (strike/error? strike)
         (Thread/sleep 1000))

+      ; reduce CPU usage also under normal circumstances
+      (Thread/sleep 10)
+
       ; stop on first failed challenge (to keep the harder challenges secret)
       (if (strike/hit? strike)
         (poll-participant app participant (rest challenges))))))


no reason for this to be inline

no reason for this to be inline

--- src/insn/clojure.clj
+++ src/insn/clojure.clj
@@ -7,9 +7,9 @@
             [insn.op :as op]
             [insn.util :as util]))

-(definline ^:private check [expr msg]
+(defmacro ^:private check [expr msg]
   `(when-not ~expr
-     (throw (clojure.lang.Util/runtimeException ~msg))))
+     (throw (RuntimeException. ~msg))))

 (clojure.core/defn- fn-decls [args]
   (let [decls (if (seq? (first args)), args [args])


fix to run

fix to run

--- src/s7p/core.clj
+++ src/s7p/core.clj
@@ -1,7 +1,7 @@
 (ns s7p.core
   (:require [clojure.data.json :as json]
             [org.httpkit.client :as http]
-            [core.async :refer [go]]))
+            [clojure.core.async :as a]))

 (def options {:timeout 100
               :keepalive 3000})
@@ -16,28 +16,28 @@
    :user "user-1"
    :test 1})

-(defn validate [{:keys status body error}]
+(defn validate [{:keys [status body error]}]
   ;; FIXME: implement
   (and
    (= status 200)
    ;; TODO: treat 204 and the others

-   (:id res)
+   (:id body)
    ;; and string

-   (:bidPrice res)
+   (:bidPrice body)
    ;; and double

-   (:advertiserId res)
+   (:advertiserId body)
    ;; and string

    )
-  {:valid res}
+  {:valid body}
   )

 (defn succeed? [res]
   ;; FIXME: implement
-  {:valid}
+  {:valid res}
   true
   )

@@ -49,6 +49,9 @@
 (defn pick-winner-and-second-price [floor-price resps]
   ;; TODO: second price
   (->> resps
+       ;; shuffle
+       ;; sort
+       ;; take2
        (argmaxes-and-second floor-price :bidPrice)
        ;; branch the size of maxes
        (rand-nth)))
@@ -71,27 +74,37 @@

+(defn floor-price [req]
+  ;; FIXME: implement
+  0
+  )
+
 (defn gen-request [n]
-  (let [c (chan)])
-  (go
-    (loop [i n]
-      (>! c request)
+  (let [c (a/chan)]
+    (a/go-loop [i n]
+      (a/>! c request)
       (if (< 0 i)
-        (recur (- i 1)))))
-  c)
+        (recur (- i 1))
+        (a/close! c)))
+    c))

 (defn process [chan]
-  (loop []
-    (let [{:keys [req result]} (<! chan)]
-      (go
-        (some->> (sequence (xf (assoc options :body (json/write-str req)))
-                       urls)
-             (pick-winner-and-second-price (floor-price req))
-             ;; log winner
-             (winnotice req result))))
-    (recur)))
+  (let [sig (a/chan)]
+   (a/go-loop []
+     (if-let [{:keys [req result]} (a/<! chan)]
+       (do
+         (a/go
+           (some->> (sequence (xf (assoc options :body (json/write-str req)))
+                              urls)
+                    (pick-winner-and-second-price (floor-price req))
+                    ;; log winner
+                    (winnotice req result)))
+         (recur))
+       (do
+         (a/close! sig))))))

 (defn -main []
-  (let [c (gen-request 1)]
-      (process chan)))
+  (let [c (gen-request 1)
+        sig (process c)]
+    (println (a/<!! sig))))


Don't run reply standalone

Don't run reply standalone

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

--- src/scripts/conexp-clj.clj
+++ src/scripts/conexp-clj.clj
@@ -21,7 +21,7 @@
     (println doc)
     ;;
     (contains? options :gui)
-    (reply/launch-standalone
+    (reply/launch
      {:custom-eval '(do
                       (use 'conexp.main)
                       (use 'clojure.repl)
@@ -41,7 +41,7 @@
         (load-file (options :load)))
     ;;
     true
-    (do (reply/launch-standalone
+    (do (reply/launch
          {:custom-eval '(do (use 'conexp.main) (use 'clojure.repl))}))))

 (System/exit 0)


Remove leading and trailing whitespace for output string.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -139,7 +139,7 @@
 (defn test-cli-stdout
   [cli-opts in-cmds]
   (let [out-str (with-out-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (start-cli cli-opts)))]
-    (.replaceAll out-str (get-prompt-string cli-opts) "")))
+    (.trim (.replaceAll out-str (get-prompt-string cli-opts) ""))))

 (defn test-cli-stderr
   [cli-opts in-cmds]


correctly cluster the vectors based on initial centroids

--- src/k_means/core.clj
+++ src/k_means/core.clj
@@ -11,8 +11,8 @@

 (defn still-moving?
   "Predicate to test if the centroids have not reached equlibrium"
-  [c]
-  true)
+  [t c]
+  (= t c))

 (defn mean
   "Retrieve the mean value of a list"
@@ -27,9 +27,8 @@

 (defn distance
   "Implements euclidian distance between two vectors"
-  ([[p1 p2] [q1 q2]]
-    (Math/sqrt (+ (Math/pow (- q1 q2) 2) (Math/pow (- p1 p2) 2)))))
-    ; (->> (map - c1 c2) (map #(* % %)) (reduce +))))) ; This is a better implementation for when this gets parallelised
+  ([c1 c2]
+    (->> (map - c1 c2) (map #(* % %)) (reduce +)))) ; This is a better implementation for when this gets parallelised

 (defn min-index
   [c]
@@ -40,13 +39,23 @@
   [c v]
     (for [i c :let [d (distance i v)]] d))

+(defn make-vector
+  "create a vector containing n cols"
+  ([n] (make-vector n []))
+  ([n c]
+    (cond
+      (<= n 0) c
+      :else
+        (recur (dec n) (conj c [])))))
+
 (defn cluster
   "take a vector and cluster it via distance"
   [g l c]
-  (println g)
   (cond
-    (empty? g) (recur (hash-set (range 0 (count c))) l c)
-    (not-empty l) (recur (conj (first l) (get g (min-index (min-distance c (first l))))) (rest l) c)
+    (nil? g) (recur (make-vector (count c)) l c)
+    (not-empty l)
+      (let [i (min-index (min-distance c (first l)))]
+        (recur (assoc g i (conj (nth g i) (first l))) (rest l) c))
     :else
     g))

@@ -66,12 +75,12 @@
 (defn k-means
   "Perform the actual k-means"
   ([l k]
-    (k-means l k (choose-initial-centroids l k) (hash-set (range 0 k))))
+    (k-means l k (choose-initial-centroids l k) (make-vector k)))
   ([l k c g]
-    (let [g (cluster g l c) c (mean-centroids g)]
+    (let [t c g (cluster g l c) c (mean-centroids g)]
       ; (println g)
       (cond
-        (still-moving? c) ; Keep shifting centroids until equilibrium
+        (still-moving? t c) ; Keep shifting centroids until equilibrium
           ; (recur nil k c g)
           g
         :else g))))
@@ -79,4 +88,4 @@
 (defn -main
   "Main function for k-means"
   [& args]
-  (k-means [[1 2] [3 2] [6 3] [1 8] [9 10] [1 4]] 3))
+  (let [c (k-means [[1 2] [3 2] [6 3] [1 8] [9 10] [1 4] [56 67] [44 53] [43 54] [43 64] [76 56]] 3)] (println c)))


fixed over-80 char lines

fixed over-80 char lines

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -332,25 +332,30 @@
                                       (.getAttributes)
                                       (.getNamedItem "href"))
                                   (try
-                                    (not= (-> a-tag
-                                              (.getAttributes)
-                                              (.getNamedItem "rel")
-                                              (.getValue))
-                                          "nofollow")
+                                    (not=
+                                     (-> a-tag
+                                         (.getAttributes)
+                                         (.getNamedItem "rel")
+                                         (.getValue))
+                                     "nofollow")
                                     (catch NullPointerException e true))

-                                  (not= (uri/scheme (-> a-tag
-                                                        (.getAttributes)
-                                                        (.getNamedItem "href")
-                                                        (.getValue)))
-                                        "javascript")
-                                  (not (some #{(uri/resolve-uri
-                                                url
-                                                (-> a-tag
-                                                    (.getAttributes)
-                                                    (.getNamedItem "href")
-                                                    (.getValue)))}
-                                             (set blacklist)))))
+                                  (not=
+                                   (uri/scheme
+                                    (-> a-tag
+                                        (.getAttributes)
+                                        (.getNamedItem "href")
+                                        (.getValue)))
+                                   "javascript")
+                                  (not
+                                   (some
+                                    #{(uri/resolve-uri
+                                       url
+                                       (-> a-tag
+                                           (.getAttributes)
+                                           (.getNamedItem "href")
+                                           (.getValue)))}
+                                    (set blacklist)))))
                            a-tags)

            nodes-xpaths   (map
@@ -366,16 +371,18 @@
                                               (.getNamedItem "href")
                                               (.getValue))]
                                  {:node x
-                                  :href (try (uri/fragment
-                                              (uri/resolve-uri url link) nil)
-                                             (catch Exception e nil))
-                                  :text (-> x
-                                            (.getTextContent))}))
+                                  :href (try
+                                          (uri/fragment
+                                           (uri/resolve-uri url link)
+                                           nil)
+                                          (catch Exception e nil))
+                                  :text (.getTextContent x)}))
                              a-tags-w-hrefs)))]

        (reduce
         (fn [acc [an-xpath node]]
-          (merge-with concat acc {an-xpath [node]})) {} nodes-xpaths))))
+          (merge-with
+           concat acc {an-xpath [node]})) {} nodes-xpaths))))

 (defn minimum-maximal-xpath-set-processed
   "This helper routine exists so we don't reparse


removed existing records matcher

removed existing records matcher

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -442,30 +442,7 @@
   "Given a set of xpaths, we compute the xpaths that
 are sufficient to generate all the distinct records"
   [xpaths processed-page]
-  (reverse (sort-by
-            count
-            (:record-sets
-             (reduce
-              (fn [acc record-set]
-                (if (= (clojure.set/union
-                        (:records acc) (set record-set))
-                       (:records acc))
-                  acc
-                  {:record-sets
-                   (conj
-                    (:record-sets acc) record-set)
-
-                   :records
-                   (clojure.set/union
-                    (:records acc) (set record-set))}))
-
-              {:record-sets []
-               :records     (set [])}
-              (reverse
-               (sort-by
-                count (map
-                       #(xpath->records % processed-page)
-                       xpaths))))))))
+  )

 (defn date-indexed-records-filter
   "records-sets: returned by minimum-maximal-xpath-records"


mini print fix

mini print fix

--- src/dartbot/udp.clj
+++ src/dartbot/udp.clj
@@ -7,6 +7,7 @@

 (defn broadcast [msg]
   (when @socket
+    (println "Broadcasting message: " msg)
     (let [message (DatagramPacket. (byte-array (map (comp byte int) msg)) (count msg) (InetAddress/getByName "255.255.255.255") default-port)]
       (.send @socket message 1000000)
       )))
@@ -34,6 +35,6 @@
       ))))

 (defn broadcast-ip []
-  (for [ip (get-ip)]
+  (doseq [ip (get-ip)]
     (when (not= ip "127.0.0.1")
       (broadcast ip))))


Add schema for inter-service-timeout-ns

Add schema for inter-service-timeout-ns

--- src/onyx/schema.cljc
+++ src/onyx/schema.cljc
@@ -391,6 +391,7 @@
    (s/optional-key :onyx.messaging/allow-short-circuit?) s/Bool
    (s/optional-key :onyx.messaging.aeron/embedded-driver?) s/Bool
    (s/optional-key :onyx.messaging.aeron/subscriber-count) s/Int
+   (s/optional-key :onyx.messaging.aeron/inter-service-timeout-ns) s/Int
    (s/optional-key :onyx.messaging.aeron/write-buffer-size) s/Int
    (s/optional-key :onyx.messaging.aeron/poll-idle-strategy) AeronIdleStrategy
    (s/optional-key :onyx.messaging.aeron/offer-idle-strategy) AeronIdleStrategy


basic company creation test

basic company creation test

--- test/open_company/integration/company/company_create.clj
+++ test/open_company/integration/company/company_create.clj
@@ -76,6 +76,16 @@
       (let [payload  {:bogus "xx" :name "hello" :description "x"}
             response (mock/api-request :post "/companies" {:body payload})]
         (:status response) => 400))
+
+    (fact "company can be created with name and description"
+      (let [payload  {:name "Hello World" :description "x"}
+            response (mock/api-request :post "/companies" {:body payload})
+            body     (mock/body-from-response response)]
+        (:status response) => 201
+        (:slug body) => "hello-world"
+        (:description body) => "x"
+        (:name body) => "Hello World"))
+
     (facts "slug"
       (fact "provided slug is taken causes 422"
         (let [payload  {:slug "open" :name "hello" :description "x"}


updating protocol.custom

updating protocol.custom

--- src/poky/protocol/custom.clj
+++ src/poky/protocol/custom.clj
@@ -10,6 +10,7 @@
 (defcodec PUT ["PUT" CR])
 (defcodec GET ["GET" CR])
 (defcodec MGET ["MGET" CR])
+(defcodec SAVED ["SAVED" CR])
 (defcodec ERRC (string :utf-8))

@@ -21,13 +22,14 @@
                           "PUT" PUT
                           "GET" GET
                           "MGET" MGET
+                          "SAVED" SAVED
                           ERRC))
                   first))

 (defn handle [ch ci cmd]
     (println "Processing command: " (first cmd) " from " ci)
     (condp = (first cmd)
-      "PUT" (do (println "doing enqueue put") (enqueue ch "got put\r\n"))
+      "PUT" (do (println "doing enqueue put") (enqueue ch ["SAVED" "got put"]))
       "GET" (enqueue ch "got get\r\n")
       "MGET" (enqueue ch "got mget\r\n")
       (enqueue ch "error")))
@@ -35,14 +37,7 @@

 (defn handler
   [ch ci]
-  ;(receive-all ch (partial handle ch ci)))
-  (fn [cmd]
-    (println "Processing command: " (first cmd) " from " ci)
-    (condp = (first cmd)
-      "PUT" (enqueue ch ["got put"])
-      "GET" (enqueue ch "got get\r\n")
-      "MGET" (enqueue ch "got mget\r\n")
-      (enqueue ch "error"))))
+  (receive-all ch (partial handle ch ci)))

 ;(def s (start-tcp-server handler {:port 10000 :frame CMDS}))


Add test for multiple foreign deps

Add test for multiple foreign deps

--- test/com/wsscode/pathom/connect/planner_readers_test.cljc
+++ test/com/wsscode/pathom/connect/planner_readers_test.cljc
@@ -372,6 +372,20 @@
                {remote [[{([::pcf/foreign-call nil] {:pathom/context {:b "boo" :a "baa"}})
                           [:c]}]]}})))

+    (testing "with multiple foreign dependencies"
+      (is (= (run-parser
+               {::resolvers [(pc/single-attr-resolver :b :D #(str % "-DD"))]
+                ::foreign   [{::foreign-id 'remote
+                              ::resolvers  [(pc/constantly-resolver :a "foo")
+                                            (pc/single-attr-resolver :a :b #(str % "-B"))
+                                            (pc/constantly-resolver :c "CCC")]}]
+                ::query     [:D ::foreign-calls]})
+             '{:D
+               "foo-B-DD"
+
+               ::foreign-calls
+               {remote [[:b]]}})))
+
     (testing "distribution"
       (is (= (run-parser
                {::resolvers [(pc/alias-resolver :video/id :great-video-service.video/id)


Make yada component idempotent

Make yada component idempotent

--- src/edge/server.clj
+++ src/edge/server.clj
@@ -21,7 +21,7 @@
   (stop [component]
     (when-let [close (get-in component [:server :close])]
       (close))
-    component))
+    (dissoc component :listener)))

 (defn new-http-server [options]
   (map->HttpServer options))


Add comment on middleware

Add comment on middleware

--- src/re_frame/middleware.cljs
+++ src/re_frame/middleware.cljs
@@ -6,7 +6,8 @@
     [clojure.data   :as data]))

-;; See docs in the Wiki: https://github.com/Day8/re-frame/wiki
+;; Middleware docs can be found in the Wiki: https://github.com/Day8/re-frame/wiki
+;; Real use can be seen in: examples/todomvc/handler.cljs

 (defn pure


resource owner password credentials grant tested

--- test/cerber/oauth2/authorization_test.clj
+++ test/cerber/oauth2/authorization_test.clj
@@ -57,7 +57,7 @@
                                        :params {:username "nioh"
                                                 :password ""}))]

-        ;; login page should be returned
+        ;; then
         (get-in state [:response :status]) => 200
         (get-in state [:response :body]) => (contains "failed")))

@@ -80,7 +80,7 @@
         (get-in state [:response :status]) => 200
         (get-in state [:response :body]) => (contains "failed")))

-(fact "user may obtain his token (wired with specific oauth client) in grant_type=authorization code scenario"
+(fact "Client may receive its token in Authorization Code Grant scenario."
       (u/purge-users)

       ;; given
@@ -120,6 +120,25 @@

         ;; then
         (let [{:keys [status body]} (:response state)]
-
           status => 200
           (slurp body) => (contains "access_token"))))
+
+(fact "Client may receive its token in Resource Owner Password Credentials Grant scenario."
+      (u/purge-users)
+
+      ;; given
+      (u/create-user {:login "nioh" :enabled true} "alamakota")
+
+      ;; when
+      (let [state (-> (session (wrap-defaults oauth-routes api-defaults))
+                      (header "Accept" "application/json")
+                      (header "Authorization" (str "Basic " (base64-auth client)))
+                      (request "/token"
+                               :request-method :post
+                               :params {:username "nioh"
+                                        :password "alamakota"
+                                        :grant_type "password"}))]
+
+        (let [{:keys [status body]} (:response state)]
+          status => 200
+          (slurp body) => (contains "access_token"))))


Circle is now inferred, so delete a test which no longer applies

--- test/circle/backend/build/test_config.clj
+++ test/circle/backend/build/test_config.clj
@@ -129,14 +129,6 @@
   (-> :setup ((parse-spec-actions {:setup "1\r\n2"}))) => (maps-containing {:name "1"} {:name "2"}))

-(fact "circle is not inferred"
-  ;; not a real "test", but currently circle shouldn't be inferred,
-  ;; and causes hard to find test failures when it's not.
-  (let [json test/circle-github-json
-        p (project/get-by-url (-> json :repository :url))]
-    (-> p :inferred) => falsey
-    (-> (build-from-json json) (run/configure) (deref) :job-name) => :build))
-
 (fact "circle deploys have :lb-name"
   (-> (circle.backend.build.config/build-from-url "https://github.com/circleci/test-yml" :job-name :deploy)
       (run/configure)


Removed test for code that was removed earlier.

I left it commented out because I want to remember how to do mocks...

--- test/com/lemondronor/turboshrimp_test.clj
+++ test/com/lemondronor/turboshrimp_test.clj
@@ -32,11 +32,12 @@
   ;;        (mock/has-args [drone "AT*REF=2,290718208\r"])
   ;;        (mock/times 1))]
   ;;      (ar-drone/command drone :take-off))))
-  (testing "drone-do-for command calls drone command every 30 sec"
-    (let [drone (ar-drone/make-drone)]
-      (mock/expect
-       [ar-drone/command
-        (->>
-         (mock/has-args [drone :take-off nil nil nil nil])
-         (mock/times #(< 0 %)))]
-       (ar-drone/drone-do-for drone 1 :take-off)))))
+  ;; (testing "drone-do-for command calls drone command every 30 sec"
+  ;;   (let [drone (ar-drone/make-drone)]
+  ;;     (mock/expect
+  ;;      [ar-drone/command
+  ;;       (->>
+  ;;        (mock/has-args [drone :take-off nil nil nil nil])
+  ;;        (mock/times #(< 0 %)))]
+  ;;      (ar-drone/drone-do-for drone 1 :take-off))))
+  )


Added test for science-keywords case sensitive parameter search.

--- test/cmr/system_int_test/search/collection_science_keyword_search_test.clj
+++ test/cmr/system_int_test/search/collection_science_keyword_search_test.clj
@@ -87,19 +87,17 @@
                                                     :topic "Popular"}
                                                 :1 {:term "Extreme"}}}))))

-    (testing "search by science keywords, ignore case false"
-      (is (d/refs-match? []
-                         (search/find-refs
-                           :collection
-                           {"science-keywords" {:0 {:category "cat1"}}
-                            "options[science-keywords][ignore-case]" "false"}))))
+    (testing "search by science keywords, ignore case"
+      (are [items science-keyword value ignore-case]
+           (d/refs-match? items
+                          (search/find-refs
+                            :collection
+                            {"science-keywords" {:0 {science-keyword value}}
+                             "options[science-keywords][ignore-case]" ignore-case}))

-    (testing "search by science keywords, ignore case true"
-      (is (d/refs-match? [coll1]
-                         (search/find-refs
-                           :collection
-                           {"science-keywords" {:0 {:category "cat1"}}
-                            "options[science-keywords][ignore-case]" "true"}))))
+           [coll1] :category "Cat1" false
+           [] :category "cat1" false
+           [coll1] :category "cat1" true))

     (testing "search by science keywords, multiple. options :or false"
       (is (d/refs-match? [coll2 coll6]


Minor fix

Minor fix

--- storm-core/src/clj/backtype/storm/daemon/supervisor.clj
+++ storm-core/src/clj/backtype/storm/daemon/supervisor.clj
@@ -665,7 +665,7 @@
           storm-log-dir (or (System/getProperty "storm.log.dir") (str storm-home file-path-separator "logs"))
           storm-log-conf-dir (conf STORM-LOG4J2-CONF-DIR)
           storm-log4j2-conf-dir (if storm-log-conf-dir
-                                  (if (is-absolute-path storm-log-conf-dir)
+                                  (if (is-absolute-path? storm-log-conf-dir)
                                     storm-log-conf-dir
                                     (str storm-home file-path-separator storm-log-conf-dir))
                                   (str storm-home file-path-separator "log4j"))


Add support to graph-fn for all clojure's binding forms.  Including support for destructuring rows positionally and by column name.

--- src/grafter/rdf.clj
+++ src/grafter/rdf.clj
@@ -85,24 +85,54 @@
   (reduce conj triple-template
           (mapcat vector hash-map)))

-(defn- canonicalise-column-names [ds]
-  (tab/make-dataset (map name (tab/column-names ds)) ds))
+(defn- get-column-by-number [ds row index]
+  (let [col-name (grafter.tabular/resolve-column-id ds index ::not-found)]
+    (if-not (= col-name ::not-found)
+      (get row col-name ::not-found))))
+
+(defn- generate-vector-bindings [ds-symbol row-symbol row-bindings]
+  (let [bindings (->> row-bindings
+                      (map-indexed (fn [index binding]
+                                     [binding `(get-column-by-number ~ds-symbol ~row-symbol ~index)]))
+                      (apply concat)
+                      (apply vector))]
+    bindings))
+
+(defn- splice-supplied-bindings [row-sym row-bindings]
+  `[~row-bindings ~row-sym])

 (defmacro graph-fn
-  "Takes FIXME followed by a series of graph or triplify forms and concatenates them
-  all together."
+  "A macro that defines an anonymous function to convert a tabular
+  dataset into a graph of RDF quads.  Ultimately it converts a
+  lazy-seq of rows inside a dataset, into a lazy-seq of RDF
+  Statements.
+
+  The function body should be composed of any number of forms, each of
+  which should return a sequence of RDF quads.  These will then be
+  concatenated together into a flattened lazy-seq of RDF statements.
+
+  Rows are passed to the function one at a time as hash-maps, which
+  can be destructured via Clojure's standard destructuring syntax.
+
+  Additionally destructuring can be done on row-indicies (when a
+  vector form is supplied) or column names (when a hash-map form is
+  supplied)."
+
   [[row-bindings] & forms]
   {:pre [(or (symbol? row-bindings) (map? row-bindings)
              (vector? row-bindings))]}
+  (let [row-sym (gensym "row")
+        ds-sym (gensym "ds")]
+    `(fn graphify-dataset [~ds-sym]
+       (letfn [(graphify-row# [~row-sym]
+                 (let ~(if (vector? row-bindings)
+                         (generate-vector-bindings ds-sym row-sym row-bindings)
+                         (splice-supplied-bindings row-sym row-bindings))
+                   (->> (concat ~@forms)
+                        (map (fn with-row-meta [triple#]
+                               (with-meta triple# {::row ~row-sym}))))))]

-  `(fn graphify-dataset [ds#]
-     (mapcat (fn graphify-row [row#]
-               (let [~row-bindings row#]
-                 (->> (concat ~@forms)
-                      (map (fn [triple#]
-                             (with-meta triple# {::row row#}))))))
-             (:rows ds#))))
-
+         (mapcat graphify-row# (:rows ~ds-sym))))))

 (defn load-triples [my-repo triple-seq]
   (doseq [triple triple-seq]


Destructuring syntax tweaks

Destructuring syntax tweaks

--- src/icecap/rest.clj
+++ src/icecap/rest.clj
@@ -33,7 +33,7 @@
   redirecting to HTTPS) are disabled. Additionally, the server will
   automatically reload code.
   "
-  [components & {dev-mode :dev-mode :or {dev-mode false}}]
+  [components & {:keys [dev-mode] :or {dev-mode false}}]
   (let [defaults (if dev-mode api-defaults secure-api-defaults)
         site (-> routes
                  (wrap-defaults defaults)


Implement alpha channel passthrough in converters classes - fixes #4

--- src/inkspot/converter.clj
+++ src/inkspot/converter.clj
@@ -1,7 +1,7 @@
 (ns inkspot.converter
   "Converters between RGB space and other colour spaces, inspired
    from python implementations from https://github.com/xav/Grapefruit"
-  (:require [inkspot.color :refer [coerce red green blue]]))
+  (:require [inkspot.color :refer [coerce red green blue alpha]]))

 (defn rgb->hsv
   "RGB to HSV (Hue, Saturation, Value) conversion."
@@ -9,6 +9,7 @@
   (let [r (/ (red color) 255.0)
         g (/ (green color) 255.0)
         b (/ (blue color) 255.0)
+        a (alpha color)
         v (max r g b)
         d (- v (min r g b))]
     (if (zero? d)
@@ -20,11 +21,11 @@
                 g (- (+ 2.0 dr) db)  ; between cyan & yellow
                 b (- (+ 4.0 dg) dr)) ; between magenta & cyan
             h (mod (* h 60.0) 360.0)]
-        [h s v]))))
+        [h s v a]))))

 (defn hsv->rgb
   "HSV (Hue, Saturation, Value) to RGB conversion."
-  [[h s v]]
+  [[h s v a]]
   (if (zero? s)
     (coerce [v v v])
     (let [h (mod (/ h 60) 6)
@@ -34,15 +35,16 @@
               (- h i))
           v (* v 255.0)
           m (* v (- 1.0 s))
-          n (* v (- 1.0 (* s f)))]
+          n (* v (- 1.0 (* s f)))
+          a (or a 1.0)]
       (coerce
         (condp = i
-          0 [v n m]
-          1 [n v m]
-          2 [m v n]
-          3 [m n v]
-          4 [n m v]
-            [v m n])))))
+          0 [v n m a]
+          1 [n v m a]
+          2 [m v n a]
+          3 [m n v a]
+          4 [n m v a]
+            [v m n a])))))

 (defn rgb->hsl
   "RGB to HSL (Hue, Saturation and Luminosity) conversion."
@@ -50,6 +52,7 @@
   (let [r (/ (red color) 255.0)
         g (/ (green color) 255.0)
         b (/ (blue color) 255.0)
+        a (alpha color)
         min-val (min r g b)
         max-val (max r g b)
         l (/ (+ max-val min-val) 2.0)]
@@ -65,11 +68,11 @@
                 g (- (+ 2.0 dr) db)
                 b (- (+ 4.0 dg) dr))
             h (mod (* h 60.0) 360.0)]
-        [h s l]))))
+        [h s l a]))))

 (defn hsl->rgb
   "HSL (Hue, Saturation and Luminosity) to RGB conversion."
-  [[h s l]]
+  [[h s l a]]
   (if (zero? s)
     (coerce [l l l])   ; achromatic (gray)
     (let [n2 (if (< l 0.5)
@@ -86,7 +89,7 @@
           r (* 255.0 (f (+ h 2)))
           g (* 255.0 (f h))
           b (* 255.0 (f (- h 2)))]
-      (coerce [r g b]))))
+      (coerce [r g b (or a 1.0)]))))

 (defn rgb->yuv
   "RGB to Y'UV (Luma, Chrominance) Conversion."
@@ -94,29 +97,30 @@
   (let [r (/ (red color) 255.0)
         g (/ (green color) 255.0)
         b (/ (blue color) 255.0)
+        a (alpha color)
         y (+ (* r  0.29900) (* g  0.58700) (* b  0.11400))
         u (+ (* r -0.14713) (* g -0.28886) (* b  0.43600))
         v (+ (* r  0.61500) (* g -0.51499) (* b -0.10001))]
-    [y u v]))
+    [y u v a]))

-(defn yuv->rgb [[y u v]]
+(defn yuv->rgb [[y u v a]]
   "Y'UV (Luma, Chrominance) to RGB Conversion."
   (let [r (* (+ y (* v 1.13983)) 255.0)
         g (* (- y (* u 0.39465) (* v 0.58060)) 255.0)
         b (* (+ y (* u 2.03211)) 255.0)]
-    (coerce [r g b])))
+    (coerce [r g b (or a 1.0)])))

 (defn grayscale
   "RGB to greyscale conversion, largely by taking the Luma
    value from Y'UV conversion."
   [color]
-  (let [[y _ _] (map (partial * 255.0) (rgb->yuv color))]
-    (coerce [y y y])))
+  (let [[y _ _ a] (map (partial * 255.0) (rgb->yuv color))]
+    (coerce [y y y a])))

 (defn complementary
   "Complimentary color conversion, largely by taking the HSL
    value, and rotating the Hue by 180 degrees, and then converting
    back to RGB."
   [color]
-  (let [[h s l] (rgb->hsl color)]
-    (hsl->rgb [(mod (+ h 180) 360) s l])))+  (let [[h s l a] (rgb->hsl color)]
+    (hsl->rgb [(mod (+ h 180) 360) s l a])))


Bind *ns* in a couple of places for reader

Needed for the new namespaced maps feature.

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -232,6 +232,7 @@
   "Returns a vector of the first read form, and any balance text."
   [source]
   (binding [ana/*cljs-ns* @current-ns
+            *ns* (create-ns @current-ns)
             env/*compiler* st
             r/*data-readers* tags/*cljs-data-readers*
             r/resolve-symbol ana/resolve-symbol
@@ -500,6 +501,7 @@
   [source]
   (let [rdr (rt/indexing-push-back-reader source 1 "noname")]
     (binding [ana/*cljs-ns* @current-ns
+              *ns* (create-ns @current-ns)
               env/*compiler* st
               r/*data-readers* tags/*cljs-data-readers*
               r/resolve-symbol ana/resolve-symbol


config: do not merge-in a default overrides config. fixes #126

--- src/io/cyanite/config.clj
+++ src/io/cyanite/config.clj
@@ -11,8 +11,7 @@
    :external false
    :console true
    :files  []
-   :level  "info"
-   :overrides {:io.cyanite "debug"}})
+   :level  "info"})

 (defn load-path
   "Try to find a pathname, on the command line, in


[fix] usernames in bold on Linux

[fix] usernames in bold on Linux

Signed-off-by: yenda <96f164ad4d9b2b0dacf8ebee2bb1eeb3aa69adf1@status.im>

--- src/status_im/ui/screens/desktop/main/chat/styles.cljs
+++ src/status_im/ui/screens/desktop/main/chat/styles.cljs
@@ -38,7 +38,8 @@

 (def author
   {:color         colors/black
-   :font-size     14})
+   :font-size     14
+   :font-weight   :bold})

 (defn chat-box [height]
   {:height            (+ height (* 2 chat-vertical-padding))


Fixes some documentation.

Fixes some documentation.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -18,11 +18,11 @@
   [clauses pattern-clauses])

 (defn pattern
-  "Takes a name and some `clauses` and returns a [[Pattern]]."
+  "Takes some `clauses` and returns a [[Pattern]]."
   [& clauses]
   (make-pattern clauses))

-;; We differentiate between three kinds of matchers:
+;; We differentiate between different kinds of matchers:
 ;; 1. Constant: Match on exactly one value. The value must be equatable.
 ;; 2. Regex: Match on a regex. The value must be a String.
 ;; 3. Existence: Match on the existence. That is, not nil.
@@ -106,10 +106,10 @@
 ;;    - optional: with binding
 ;; 3. Match a key in a map to some specific value.
 ;;    - without binding - with binding
-;;    - optional:  with binding
+;;    - optional: with binding
 ;; 4. Match the value at a path in a map to a specific value.
 ;;    - without binding - with binding
-;;    - optional:  with binding
+;;    - optional: with binding

 ;; 1.
 (define-record-type KeyExistsWithoutBindingClause
@@ -131,7 +131,7 @@
    binding key-exists-with-binding-clause-binding])

 (defn key-exists-with-binding-clause
-  "Returns a clause that asserts the existence of a non-nil value at `key`."
+  "Returns a clause that asserts the existence of a non-nil value at `key`. When evaluated, binds it's result to `binding`."
   [key binding]
   (make-key-exists-with-binding-clause key binding))

@@ -154,7 +154,7 @@
    binding optional-key-exists-with-binding-clause-binding])

 (defn optional-key-exists-with-binding-clause
-  "Returns an optional clause that asserts the existence of a non-nil value at `key`."
+  "Returns an optional clause that asserts the existence of a non-nil value at `key`. When evaluated, binds it's result to `binding`."
   [key bind]
   (make-optional-key-exists-with-binding-clause key bind))

@@ -166,7 +166,7 @@
   [path path-exists-without-binding-clause-path])

 (defn path-exists-without-binding-clause
-  "Returns a clause that asserts the existence of a non-nil value at `key`."
+  "Returns a clause that asserts the existence of a non-nil value at `path`."
   [path]
   (make-path-exists-without-binding-clause path))

@@ -178,7 +178,7 @@
    binding path-exists-with-binding-clause-binding])

 (defn path-exists-with-binding-clause
-  "Returns a clause that asserts the existence of a non-nil value at `key`."
+  "Returns a clause that asserts the existence of a non-nil value at `path`. When evaluated, binds it's result to `binding`."
   [path bind]
   (make-path-exists-with-binding-clause path bind))

@@ -189,7 +189,7 @@
   [path optional-path-exists-without-binding-clause-path])

 (defn optional-path-exists-without-binding-clause
-  "Returns an optional clause that asserts the existence of a non-nil value at `key`."
+  "Returns an optional clause that asserts the existence of a non-nil value at `path`."
   [path]
   (make-optional-path-exists-without-binding-clause path))

@@ -201,7 +201,7 @@
    binding optional-path-exists-with-binding-clause-binding])

 (defn optional-path-exists-with-binding-clause
-  "Returns an optional clause that asserts the existence of a non-nil value at `key`."
+  "Returns an optional clause that asserts the existence of a non-nil value at `path`. When evaluated, binds it's result to `binding`."
   [path bind]
   (make-optional-path-exists-with-binding-clause path bind))

@@ -244,7 +244,7 @@

 (defn optional-key-with-default-binding-clause
   "Returns an optional clause that matches a `key`, binding the
-  match to a symbol based on `key` or the default value."
+  match to a symbol based on `key` or the `default-value`."
   [key default-value bind]
   (make-optional-key-with-default-binding-clause key default-value bind))

@@ -257,6 +257,7 @@
    matcher path-matches-without-binding-clause-matcher])

 (defn path-matches-without-binding-clause
+  "Returns a clause that matches a `path` with a certain `matcher`."
   [path matcher]
   {:pre [(and (path? path) (matcher? matcher))]}
   (make-path-matches-without-binding-clause path matcher))
@@ -270,6 +271,8 @@
    binding path-matches-with-binding-clause-binding])

 (defn path-matches-with-binding-clause
+  "Returns a clause that matches a `path` with a certain `matcher`, binding the
+  match to a symbol based on `path`."
   [path matcher bind]
   {:pre [(and (path? path) (matcher? matcher))]}
   (make-path-matches-with-binding-clause path matcher bind))
@@ -283,6 +286,8 @@
    binding optional-path-with-default-binding-clause-binding])

 (defn optional-path-with-default-binding-clause
+  "Returns an optional clause that matches a `path`, binding the
+  match to a symbol based on `path` or the `default-value`."
   [path default-value bind]
   {:pre [(path? path)]}
   (make-optional-path-with-default-binding-clause path default-value bind))


CMR-2153 Updates native id field order.

CMR-2153 Updates native id field order.

--- system-int-test/src/cmr/system_int_test/data2/core.clj
+++ system-int-test/src/cmr/system_int_test/data2/core.clj
@@ -19,7 +19,7 @@
 (defn- item->native-id
   "Returns the native id of a UMM record."
   [item]
-  (some #(get item %) [:granule-ur :entry-title :native-id :EntryTitle]))
+  (some #(get item %) [:granule-ur :entry-title :EntryTitle :native-id]))

 (defn item->concept
   "Returns a concept map from a UMM item or tombstone. Default provider-id to PROV1 if not present."


Added docstrings to the lambda-blog.utils namespace.

--- src/lambda_blog/utils.clj
+++ src/lambda_blog/utils.clj
@@ -1,4 +1,5 @@
 (ns lambda-blog.utils
+  "Various useful utilities."
   (:require [clj-time.format :as f]
             [clojure.string :refer [split]]
             [ring.util.codec :refer [url-encode]]))
@@ -12,17 +13,23 @@
   ([a] a)
   ([a b] (str a "/" b)))

-(defn pathcat [& parts]
+(defn pathcat
+  "Concatenates filesystem/URL paths `parts` while maintaining correct format."
+  [& parts]
   (reduce join
           (filter (complement empty?)
                   (flatten (map (partial parse #"/")
                                 parts)))))

-(defn format-date [timestamp]
+(defn format-date
+  "Formats a `timestamp` according to a given format."
+  [timestamp]
   (f/unparse (f/formatter "YYYY-MM-dd HH:mm")
              (f/parse timestamp)))

-(defn sanitize [name]
+(defn sanitize
+  "Sanitizes a `string` for use in URLs and filesystem paths."
+  [string]
   ;; FIXME Probably needs to be FS safe in addition to being URL-safe.
-  (when name
-    (url-encode name)))
+  (when string
+    (url-encode string)))


Change old split-word into fuzzy-split-word. Add new split-word function to handle cases qu and gi

--- src/bogo_clojure/bg_word.clj
+++ src/bogo_clojure/bg_word.clj
@@ -8,7 +8,7 @@
 ;;; this namespace have to be a valid vietnamese word or be able to
 ;;; develop to a valid vietnamese word.

-(defn split-word
+(defn fuzzy-split-word
   "Split a word into 3 components: first-consonant, vowel,
 last-consonant * last-consonant: the longest substring of consonants
 at the end of given word * vowel: the longest substring of vowel next
@@ -17,7 +17,7 @@
 Return value is a vector with the form:
 [first-consonant vowel last-consonant]

-Usage: (split-word word)"
+Usage: (fuzzy-split-word word)"
   [word]
   (let [rword (reverse word)]
     (map string/reverse
@@ -35,3 +35,7 @@
                  rword))
     )
   )
+
+(defn split-word
+  [word]
+  (fuzzy-split-word word))


Update migration to add quests to all users

--- src/braid/server/migrate.clj
+++ src/braid/server/migrate.clj
@@ -36,7 +36,16 @@
        :db/valueType :db.type/long
        :db/cardinality :db.cardinality/one
        :db/id #db/id [:db.part/db]
-       :db.install/_attribute :db.part/db}]))
+       :db.install/_attribute :db.part/db}])
+
+  (let [user-ids (->> (d/q '[:find ?user-id
+                             :in $
+                             :where
+                             [?u :user/id ?user-id]]
+                           (d/db db/conn))
+                      (map first))]
+    (doseq [user-id user-ids]
+      (db/activate-first-quests! user-id))))

 (defn migrate-2016-07-29
   "Add watched threads for bots"


Remove config that would end up in jar/uberjar.

This should probably be defined as close to runtime by the user as possible

--- resources/config.clj
+++ resources/config.clj
@@ -1,12 +0,0 @@
-{:db {:classname "org.sqlite.JDBC"
-      :subprotocol "sqlite"
-      :subname "data/db"}
- :key-file "data/authorized_keys"
- :repo "/home/clojars/repo"
- :bcrypt-work-factor 12
- :mail {:hostname "smtp.gmail.com"
-        :from "noreply@clojars.org"
-        :username "clojars@pupeno.com"
-        :password "fuuuuuu"
-        :port 465 ; If you change ssl to false, the port might not be effective, search for .setSSL and .setSslSmtpPort
-        :ssl true}}


Hbridge stop is more effficient now by turning off all relays

--- src/chicken_coop/hbridge.clj
+++ src/chicken_coop/hbridge.clj
@@ -50,8 +50,10 @@
       (bb/write! power :off)
       (bb/writes! [+pin -pin] :on)
       (bb/write! power :on)))
-  (stop! [_]
-    (bb/write! power :off)))
+  (stop! [this]
+    (with-sleeps (or (:ms-wait this) 20)
+      (bb/write! power :off)
+      (bb/writes! [+pin -pin] :off))))

 (defrecord HBridge2Pin [power pin]
@@ -66,8 +68,10 @@
       (bb/write! power :off)
       (bb/write! pin :on)
       (bb/write! power :on)))
-  (stop! [_]
-    (bb/write! power :off)))
+  (stop! [this]
+    (with-sleeps (or (:ms-wait this) 10)
+      (bb/write! power :off)
+      (bb/write! pin :off))))

 (defn hbridge


Email notification fixes

Email notification fixes

--- src/clj/salava/mail/mail.clj
+++ src/clj/salava/mail/mail.clj
@@ -1,5 +1,6 @@
 (ns salava.mail.mail
   (:require [clojure.java.io :as io]
+            [clojure.tools.logging :as log]
             [hiccup.core :refer :all]
             [postal.core :refer [send-message]]
             [salava.core.util :refer [get-site-url get-base-path get-site-name get-plugins plugin-fun]]
@@ -7,77 +8,70 @@
             [slingshot.slingshot :refer :all]
             [salava.core.i18n :refer [t]]))

+(defn- send-mail-to [mail-host-config msg to]
+  (try+
+    (log/info "sending to" to)
+    (if (nil? mail-host-config)
+      (send-message (assoc msg :to to))
+      (send-message mail-host-config (assoc msg :to to)))
+    (catch Object ex
+      (log/error ex))))
+
 (defn send-mail [ctx subject message recipients]
-  (try+
-    (let [mail-host-config (get-in ctx [:config :core :mail-host-config])
-          data {:from    (get-in ctx [:config :core :mail-sender])
-                :bcc      recipients
-                :subject subject
-                :body    [{:type    "text/plain; charset=utf-8"
-                           :content message}]}]
-      (if (nil? mail-host-config)
-        (send-message data)
-        (send-message mail-host-config data)))
-    (catch Object _
-      ;TODO log an error
-      )))
+  (let [mail-host-config (get-in ctx [:config :core :mail-host-config])
+        data {:from    (get-in ctx [:config :core :mail-sender])
+              :subject subject
+              :body    [{:type    "text/plain; charset=utf-8"
+                         :content message}]}]
+    (doseq [to recipients]
+      (-> (send-mail-to mail-host-config data to) log/info))))

 (defn send-html-mail [ctx subject message recipients]
-  (try+
-    (let [mail-host-config (get-in ctx [:config :core :mail-host-config])
-          data {:from    (get-in ctx [:config :core :mail-sender])
-                :bcc      recipients
-                :subject subject
-                :body    [{:type "text/html; charset=utf-8"
-                           :content message}]}]
-      (if (nil? mail-host-config)
-        (send-message data)
-        (send-message mail-host-config data)))
-    (catch Object _
-      ;TODO log an error
-      )))
+  (let [mail-host-config (get-in ctx [:config :core :mail-host-config])
+        data {:from    (get-in ctx [:config :core :mail-sender])
+              :subject subject
+              :body    [{:type "text/html; charset=utf-8"
+                         :content message}]}]
+    (doseq [to recipients]
+      (-> (send-mail-to mail-host-config data to) log/info))))

 (defn send-activation-message [ctx site-url activation-link login-link fullname email-address lng]
   (let [site-name (get-in ctx [:config :core :site-name])
         subject (str (t :core/Welcometo lng) " " site-name (t :core/Service lng))
-        message (str fullname
-                     ",\n\n" (t :core/Emailactivation2 lng) " " site-url  ".\n" (t :core/Emailactivation4 lng) ":\n\n"
+        message (str (t :core/Hello lng) " " fullname
+                     ",\n\n" (t :core/Emailactivation2 lng) " " site-name  ".\n" (t :core/Emailactivation4 lng) ":\n\n"
                      activation-link
                      "\n\n" (t :core/Emailactivation5 lng) "\n" (t :core/Emailactivation6 lng) ".\n\n" (t :core/Emailactivation7 lng) "\n"
                      login-link
-                     " " (t :core/Emailactivation8 lng) ".\n\n--  "site-name " -"(t :core/Team lng))]
+                     " " (t :core/Emailactivation8 lng) ".\n\n"
+                     (t :user/Emailnotificationtext4 lng) ", " site-name " " (t :core/Team lng))]
     (send-mail ctx subject message [email-address])))

 (defn send-password-reset-message [ctx site-url activation-link fullname email-address lng]
   (let [site-name (get-in ctx [:config :core :site-name])
         subject (str  site-name " " (t :core/Emailresetheader lng))
-        message (str fullname ",\n\n" (t :core/Emailresetmessage1 lng) " " site-url
+        message (str (t :core/Hello lng) " " fullname ",\n\n" (t :core/Emailresetmessage1 lng) " " site-name
                      ".\n\n" (t :core/Emailactivation4 lng)":\n\n"
                      activation-link
-                     "\n\n" (t :core/Emailactivation5 lng) "\n" (t :core/Emailactivation6 lng) ".\n\n" (t :core/Emailresetmessage2 lng) ".\n\n--  "
-                      site-name " -"(t :core/Team lng))]
+                     "\n\n" (t :core/Emailactivation5 lng) "\n" (t :core/Emailactivation6 lng) ".\n\n" (t :core/Emailresetmessage2 lng) ".\n\n"
+                     (t :user/Emailnotificationtext4 lng) ", " site-name " " (t :core/Team lng))]
     (send-mail ctx subject message [email-address])))

 (defn send-verification [ctx site-url email-verification-link fullname email lng]
   (let [site-name (get-in ctx [:config :core :site-name])
         subject (str (t :core/Emailverification1 lng) " " site-name )
-        message (str fullname "\n\n" (t :core/Emailverification2 lng) " '" email "' " (t :core/Emailverification3 lng) " " site-url".\n" (t :core/Emailverification4 lng) ":\n\n"
+        message (str (t :core/Hello lng) " " fullname ",\n\n" (t :core/Emailverification2 lng) " '" email "' " (t :core/Emailverification3 lng) " " site-name".\n" (t :core/Emailverification4 lng) ":\n\n"
                      email-verification-link
-                     "\n\n" (t :core/Emailverification6 lng)".\n")]
+                     "\n\n" (t :core/Emailverification6 lng)".\n\n"
+                     (t :user/Emailnotificationtext4 lng) ", " site-name " " (t :core/Team lng))]
     (send-mail ctx subject message [email])))
-
-
-
-

 (defn get-fragments
   ([ctx type] (get-fragments ctx nil nil type))
   ([ctx user lng type]
-   (let [funs (plugin-fun (get-plugins ctx) "mail" "get-fragment")]
-     (remove nil? (map (fn [f] (try (f ctx user lng type) (catch Throwable _))) funs))
-     ))
-  )
+   (let [funs (plugin-fun (get-plugins ctx) "mail" "get-fragment")]
+     (remove nil? (map (fn [f] (try (f ctx user lng type) (catch Throwable _))) funs)))))

 (def style-string (slurp (io/resource "public/css/email.css")))
@@ -108,7 +102,6 @@
         [:tr.emailTitle
          [:td
           banner]]]]]]))
-

 (defn html-mail-header-title [text]
@@ -153,9 +146,6 @@
           [:p (str (t :user/Emailnotificationtext4 lng) ",") ]
           [:p site-name " - "(t :core/Team lng)]
           ]]]]]]))
-
-
-

 (defn html-mail-template [ctx user lng subject type]
@@ -219,8 +209,4 @@
          [:br]
         [:br]
         footer
-        "<!-- Email wrapper : END -->"]
-
-
-       ))
-    ))
+        "<!-- Email wrapper : END -->"]))))


Move around codec constructor unmapping.

--- src/multicodec/codecs.clj
+++ src/multicodec/codecs.clj
@@ -53,6 +53,11 @@
       (mc/decode! codec input))))

+;; Remove automatic constructor functions.
+(ns-unmap *ns* '->HeaderCodec)
+(ns-unmap *ns* 'map->HeaderCodec)
+
+
 (defn wrap-headers
   "Creates a new codec which will write the header for the wrapped codec before
   calling it. When decoding, it will read the header before calling the wrapped
@@ -61,11 +66,6 @@
    (wrap-headers codec (:header codec)))
   ([codec header]
    (HeaderCodec. header codec)))
-
-
-;; Remove automatic constructor functions.
-(ns-unmap *ns* '->HeaderCodec)
-(ns-unmap *ns* 'map->HeaderCodec)

@@ -193,15 +193,15 @@
       (.toByteArray baos))))

+;; Remove automatic constructor functions.
+(ns-unmap *ns* '->BinaryCodec)
+(ns-unmap *ns* 'map->BinaryCodec)
+
+
 (defn bin-codec
   "Creates a new binary codec."
   []
   (BinaryCodec. (mc/headers :bin)))
-
-
-;; Remove automatic constructor functions.
-(ns-unmap *ns* '->BinaryCodec)
-(ns-unmap *ns* 'map->BinaryCodec)

@@ -230,6 +230,11 @@
           writer (StringWriter.)]
       (io/copy reader writer)
       (.toString writer))))
+
+
+;; Remove automatic constructor functions.
+(ns-unmap *ns* '->TextCodec)
+(ns-unmap *ns* 'map->TextCodec)

 (defn text-codec
@@ -238,8 +243,3 @@
    (text-codec (Charset/forName "UTF-8")))
   ([charset]
    (TextCodec. (str "/text/" charset) charset)))
-
-
-;; Remove automatic constructor functions.
-(ns-unmap *ns* '->TextCodec)
-(ns-unmap *ns* 'map->TextCodec)


whitespace

whitespace

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1396,13 +1396,6 @@
                          ;; if a verb has an object,
                          ;; and the object is not {:reflexive true}
                          ;; then the object is {:reflexive false}
-
                          (if-then {:synsem {:cat :verb
                                             :subcat {:2 {:reflexive false}}}}
                                   {:synsem {:subcat {:2 {:reflexive false}}}}))))
-
-
-
-
-
-


"llamarse": person is *not* shared by named (:1) and name-as (:3).

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -402,16 +402,16 @@
                     :sem {:human true
                           :pred :Juan}
                     :subcat '()}}
-    "Juan y yo"
-      [{:synsem {:cat :noun
-                 :pronoun true
-                 :case :nom
-                 :agr {:gender :masc
-                       :person :1st
-                       :number :plur}
-                 :sem {:human true
-                       :pred :Juan-and-i}
-                 :subcat '()}}]
+   "Juan y yo"
+   [{:synsem {:cat :noun
+              :pronoun true
+              :case :nom
+              :agr {:gender :masc
+                    :person :1st
+                    :number :plur}
+              :sem {:human true
+                    :pred :Juan-and-i}
+              :subcat '()}}]
    "la"
    (unify determiner
           {:synsem {:cat :det
@@ -451,20 +451,24 @@
    "llamarse"
    (let [subject-semantics (ref {:human true})
          called-semantics (ref :top)
-         subject-agr (ref :top)]
+         subject-gender (ref :top)
+         subject-number (ref :top)]
      {:synsem {:cat :verb
                :sem {:pred :be-called
                      :reflexive true
                      :subj subject-semantics
                      :obj called-semantics}
-               :subcat {:1 {:agr subject-agr
+               :subcat {:1 {:agr {:number subject-number
+                                  :gender subject-gender}
                             :propernoun false ;; avoid things like 'Juan se llamó Juan'
                             :sem subject-semantics}
-                        :2 {:agr subject-agr
+                        :2 {:agr {:number subject-number
+                                  :gender subject-gender}
                             :pronoun true
                             :reflexive true
                             :sem subject-semantics}
-                        :3 {:agr subject-agr
+                        :3 {:agr {:number subject-number
+                                  :gender subject-gender}
                             :cat :noun
                             :subcat '()
                             :propernoun true}}}})


remove semantics from reflexive pronouns: allows reflexive pronouns to work with reflexive verbs like 'llamarse', where named semantics are shared with reflexive pronoun semantics

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -479,8 +479,6 @@
                   :case pronoun-acc
                   :agr {:person :1st
                         :number :sing}
-                  :sem {:pred :I
-                        :human true}
                   :subcat '()}}

    "mentir" {:espanol {:boot-stem "mient"}
@@ -614,8 +612,6 @@
                   :case pronoun-acc
                   :agr {:person :2nd
                         :number :sing}
-                  :sem {:pred :tu
-                        :human true}
                   :subcat '()}}

    "tirar" [{:synsem {:cat :verb


s/vp-aux-22/vp-aux/

--- src/babel/francais/writer.clj
+++ src/babel/francais/writer.clj
@@ -1,24 +1,25 @@
 (ns babel.francais.writer
   (:refer-clojure :exclude [get-in]))

-(require '[clojure.string :as string])
-(require '[clojure.tools.logging :as log])
-
-(require '[dag-unify.core :refer (fail? get-in strip-refs)])
 (require '[babel.cache :refer [create-index]])
 (require '[babel.english.writer :as en])
 (require '[babel.enrich :refer [enrich]])
 (require '[babel.forest :as forest])
 (require '[babel.francais.grammar :refer [grammar]])
 (require '[babel.francais.lexicon :refer [lexicon-source]])
-(require '[babel.francais.morphology :refer [analyze exception-generator fo get-string phonize]])
+(require '[babel.francais.morphology :refer [analyze exception-generator
+                                             fo get-string phonize]])
+(require '[babel.francais.pos :refer [intransitivize transitivize]])
 (require '[babel.lexiconfn :refer (compile-lex map-function-on-map-vals unify)])
 (require '[babel.parse :as parse])
-(require '[babel.francais.pos :refer [intransitivize transitivize]])
 (require '[babel.ug :refer [head-principle]])
 (require '[babel.writer :refer [process write-lexicon]])
+(require '[clojure.string :as string])
+(require '[clojure.tools.logging :as log])
+(require '[dag-unify.core :refer (fail? get-in strip-refs)])

-;; see TODOs in lexiconfn/compile-lex (should be more of a pipeline as opposed to a argument-position-sensitive function.
+;; see TODOs in lexiconfn/compile-lex (should be more of a pipeline
+;; as opposed to a argument-position-sensitive function.
 (def lexicon
   (future (-> (compile-lex lexicon-source exception-generator phonize)

@@ -30,65 +31,14 @@
               transitivize

               ;; Cleanup functions can go here. Number them for ease of reading.
-              ;; 1. this filters out any verbs without an inflection: infinitive verbs should have inflection ':infinitive',
+              ;; 1. this filters out any verbs without an inflection:
+              ;; infinitive verbs should have inflection ':infinitive',
               ;; rather than not having any inflection.
               (map-function-on-map-vals
                (fn [k vals]
                  (filter #(or (not (= :verb (get-in % [:synsem :cat])))
                               (not (= :none (get-in % [:synsem :infl] :none))))
                          vals))))))
-
-(defn lookup [token]
-  "return the subset of lexemes that match this token from the lexicon."
-  (analyze token #(get @lexicon %)))
-
-(def fr lookup) ;; abbreviation for the above
-
-(defn parse [string]
-  (parse/parse string lexicon lookup grammar))
-
-(def index nil)
-;; TODO: trying to print index takes forever and blows up emacs buffer:
-;; figure out how to change printable version to (keys index).
-(def index (future (create-index grammar (flatten (vals @lexicon)) head-principle)))
-
-(defn generate [ & [spec {use-grammar :grammar
-                          use-index :index
-                          use-lexicon :lexicon}]]
-  (let [spec (if spec spec :top)
-        use-grammar (if use-grammar use-grammar grammar)
-        use-index (if use-index use-index index)
-        use-lexicon (if use-lexicon use-lexicon lexicon)]
-    (log/info (str "using grammar of size: " (.size use-grammar)))
-    (if (seq? spec)
-      (map generate spec)
-      (forest/generate spec use-grammar
-                       (flatten (vals @use-lexicon))
-                       use-index))))
-
-(defn sentence [ & [spec]]
-  (let [spec (unify (if spec spec :top)
-                    {:synsem {:subcat '()
-                              :cat :verb}})]
-    (generate spec {:use-grammar grammar
-                    :use-index index
-                    :use-lexicon (flatten (vals @lexicon))})))
-
-;; TODO: factor out to forest/.
-(defn generate-all [ & [spec {use-grammar :grammar
-                              use-index :index
-                              use-lexicon :lexicon}]]
-  (let [spec (if spec spec :top)
-        use-grammar (if use-grammar use-grammar grammar)
-        use-index (if use-index use-index index)
-        use-lexicon (if use-lexicon use-lexicon lexicon)]
-    (log/info (str "using grammar of size: " (.size use-grammar)))
-    (log/info (str "using index of size: " (.size @use-index)))
-    (if (seq? spec)
-      (mapcat generate-all spec)
-      (forest/generate-all spec use-grammar
-                           (flatten (vals @use-lexicon))
-                           use-index))))
 (def small
   (future
     (let [grammar
@@ -97,7 +47,7 @@
                        (= (:rule %) "s-future-nonphrasal")
                        (= (:rule %) "s-imperfect-nonphrasal")
                        (= (:rule %) "s-aux")
-                       (= (:rule %) "vp-aux-22"))
+                       (= (:rule %) "vp-aux"))
                   grammar)
           lexicon
           (into {}