add get-page testcase

add get-page testcase

--- test/synthesis_crawlers/core_test.clj
+++ test/synthesis_crawlers/core_test.clj
@@ -24,9 +24,12 @@
   (testing "returns something if the specified extractor is used"
     (is (crawled? {"site-url" ["container-expr" {:attr "partial-expr"}]} #{{"site-url" ["container-expr" {:attr "partial-expr"}]}}))))

-#_(deftest get-page-test
-    (testing "gets the specified web page and return its body"
-      (is (starts-with? (get-page "http://www.http-kit.org/") "<!DOC"))))
+(deftest get-page-test
+    (testing "Gets the specified web page and return its body.
+              If the specified page is not found, it will return nil."
+      (is (starts-with? (get-page "http://www.http-kit.org/") "<!DOC"))
+      (is (= (get-page "https://hoasdfasdfa/") nil))
+      ))

 (deftest build-selector-test
   (testing "builds a selector"
@@ -98,6 +101,9 @@
     ))
 (deftest fetch-web-pages-test
   #_(testing "fetches web pages"
-    (is (= (take 2 (fetch-urls "http://www.economist.com/" #"^http://www\.economist\.com/blogs/.+$" #{}))
+    (is (= (take 2 (fetch-urls "http://www.economist.com"
+                               #"^http://www\.economist\.com/blogs/.+$"
+                               []
+                               #{}))
            nil))))


CLJS-1281: Preserve test order

CLJS-1281: Preserve test order

Achieved by sorting the test vars by :line when creating the ns test-block.

--- src/main/cljs/cljs/test.clj
+++ src/main/cljs/cljs/test.clj
@@ -321,12 +321,11 @@
              `(cljs.test/update-current-env! [:each-fixtures] assoc '~ns
                                              ~(symbol (name ns) "cljs-test-each-fixtures"))))]
        (cljs.test/test-vars-block
-        [~@(map
-            (fn [[k _]]
-              `(var ~(symbol (name ns) (name k))))
-            (filter
-             (fn [[_ v]] (:test v))
-             (ana-api/ns-interns ns)))])
+        [~@(->> (ana-api/ns-interns ns)
+                (filter (fn [[_ v]] (:test v)))
+                (sort-by (fn [[_ v]] (:line v)))
+                (map (fn [[k _]]
+                       `(var ~(symbol (name ns) (name k))))))])
        [(fn []
           (when (nil? env#)
             (cljs.test/clear-env!)))]))))


update compjure dependency

update compjure dependency

--- src/leiningen/new/cryogen/project.clj
+++ src/leiningen/new/cryogen/project.clj
@@ -5,7 +5,7 @@
                       :url "http://www.eclipse.org/legal/epl-v10.html"}
             :dependencies [[org.clojure/clojure "1.6.0"]
                            [ring/ring-devel "1.3.2"]
-                           [compojure "1.3.2"]
+                           [compojure "1.3.4"]
                            [ring-server "0.4.0"]
                            [cryogen-markdown "0.1.1"]
                            [cryogen-core "0.1.21"]]


fix(material): js annotation

fix(material): js annotation

--- material/src/re_view/material/mdc.cljs
+++ material/src/re_view/material/mdc.cljs
@@ -32,7 +32,7 @@
   Adapters are written to the component on a property of the form `mdc{ComponentName}`"
   [component & adapters]
   (doseq [{:keys [name adapter]} adapters]
-    (let [foundation (adapter component)]
+    (let [^js foundation (adapter component)]
       (gobj/set component (str "mdc" name) foundation)
       (.init foundation))))

@@ -40,7 +40,7 @@
   "Destroy mdc foundation instances for component (should be called in componentWillUnmount)."
   [component & adapters]
   (doseq [{:keys [name]} adapters]
-    (let [foundation (gobj/get component (str "mdc" name))]
+    (let [^js foundation (gobj/get component (str "mdc" name))]
       (when-let [onDestroy (aget foundation "adapter_" "onDestroy")]
         (onDestroy))
       (.destroy foundation))))


Diable swagger validation in v2

Diable swagger validation in v2

--- src/ardoq/swagger/api.clj
+++ src/ardoq/swagger/api.clj
@@ -46,11 +46,13 @@
           (throw (ex-info  "InvalidSwagger" {:causes message}))))))

 (defn version2 [client spec wsname]
-  (let [{:keys [success message]} (validate/validate-swagger "schemav2.json" (generate-string spec))]
-    (if success
-      (swaggerv2/import-swagger2 client spec wsname)
-      (do (println "Not a valid Swagger file\nError: ")
-          (throw (ex-info "InvalidSwagger" {:causes message}))))))
+  (swaggerv2/import-swagger2 client spec wsname)
+  ;; (let [{:keys [success message]} (validate/validate-swagger "schemav2.json" (generate-string spec))]
+  ;;     (if success
+  ;;       (swaggerv2/import-swagger2 client spec wsname)
+  ;;       (do (println "Not a valid Swagger file\nError: ")
+  ;;           (throw (ex-info "InvalidSwagger" {:causes message})))))
+  )

 (defn- resolve-spec [spec url headers]
   (if (not (blank? spec))


CMR-1830: Kebab case the keywords that come back from KMS

--- transmit-lib/src/cmr/transmit/kms.clj
+++ transmit-lib/src/cmr/transmit/kms.clj
@@ -1,8 +1,9 @@
 (ns cmr.transmit.kms
   "This namespace handles retrieval of controlled vocabulary from the GCMD Keyword Management
   System (KMS)."
-  (:require [clj-http.client :as client]
-            [clojure.string :as str]
+  (:require [clojure.string :as str]
+            [clj-http.client :as client]
+            [camel-snake-kebab.core :as csk]
             [cmr.transmit.config :as config]
             [cmr.transmit.connection :as conn]
             [cmr.common.util :as util]
@@ -11,7 +12,7 @@
 (def leaf-node-field-name
   "A map of the concept-scheme to the field name within that concept-scheme that identifies an
   entry as a leaf node."
-  {:providers :Short_Name})
+  {:providers :short-name})

 (defn- parse-single-csv-line
   "Parses a single CSV line into an array of values. An example line:
@@ -35,7 +36,7 @@
   [concept-scheme csv-content]
   (let [all-lines (str/split-lines csv-content)
         ;; Line 2 contains the names of the subfield names
-        subfield-names (map keyword (parse-single-csv-line (second all-lines) ","))
+        subfield-names (map csk/->kebab-case-keyword (parse-single-csv-line (second all-lines) ","))
         keyword-values (map util/remove-blank-keys
                             (map #(zipmap subfield-names (parse-single-csv-line % "\",\""))
                             ;; Lines 3 to the end are the values
@@ -46,10 +47,10 @@

 (comment
   (take 10 (get-provider-hierarchy {:system (cmr.search.system/create-system)}))
-  (count (set (map :Short_Name (get-provider-hierarchy {:system (cmr.search.system/create-system)}))))
-  (count (map :Short_Name (get-provider-hierarchy {:system (cmr.search.system/create-system)})))
+  (count (set (map :short-name (get-provider-hierarchy {:system (cmr.search.system/create-system)}))))
+  (count (map :short-name (get-provider-hierarchy {:system (cmr.search.system/create-system)})))
   ;; Look for any duplicate providers
-  (for [v (vals (group-by keyword (map :Short_Name (get-provider-hierarchy
+  (for [v (vals (group-by keyword (map :short-name (get-provider-hierarchy
                                                      {:system (cmr.search.system/create-system)}))))
         :when (> (count v) 1)]
     v))


CMR-8093 - a suggestion was made to move this to info from debug (#1528)

--- transmit-lib/src/cmr/transmit/kms.clj
+++ transmit-lib/src/cmr/transmit/kms.clj
@@ -65,7 +65,7 @@
    CMR_KMS_SCHEMA_OVERRIDE_JSON."
   []
   (let [overrides (config/kms-scheme-override-json)]
-    (debug (format "Requested KMS schema overrides: %s." overrides))
+    (info (format "Requested KMS schema overrides: %s." overrides))
     (try
       (json/parse-string overrides true)
       (catch com.fasterxml.jackson.core.JsonParseException e


Extract the upload well into a function

Extract the upload well into a function

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -160,6 +160,21 @@
         response/response
         (response/content-type "application/pdf"))))

+(defn- upload-well
+  [title url errors]
+  [:div.well
+   [:h2 title]
+   (when (seq errors)
+     [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
+   (form/form-to
+    {:enctype "multipart/form-data"
+     :class "form-inline"}
+    [:post url]
+    (anti-forgery-field)
+    (form/file-upload "file")
+    " "
+    (form/submit-button {:class "btn btn-default"} "Upload"))])
+
 (defn upload-form [request year issue & [errors]]
   (let [identity (friend/identity request)]
     (layout/common
@@ -167,18 +182,9 @@
      year issue
      [:div.row
       [:div.col-md-12
-       [:div.well
-        [:h2 (format "Upload %s" (translations :catalog-all))]
-        (when (seq errors)
-          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
-        (form/form-to
-         {:enctype "multipart/form-data"
-          :class "form-inline"}
-         [:post (format "/%s/%s/%s/upload-confirm" year issue (name :all-formats))]
-         (anti-forgery-field)
-         (form/file-upload "file")
-         " "
-         (form/submit-button {:class "btn btn-default"} "Upload"))]]])))
+       (upload-well (format "Upload %s" (translations :catalog-all))
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :all-formats))
+                    errors)]])))

 (defn upload-confirm [request year issue fmt file]
   (let [{tempfile :tempfile} file
@@ -235,45 +241,18 @@
      year issue
      [:div.row
       [:div.col-md-6
-       [:div.well
-        [:h2 "Upload Gesamtkatalog Hörfilm"]
-        (when (seq errors)
-          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
-        (form/form-to
-         {:enctype "multipart/form-data"
-          :class "form-inline"}
-         [:post (format "/%s/%s/%s/upload-confirm" year issue (name :hörfilm))]
-         (anti-forgery-field)
-         (form/file-upload "file")
-         " "
-         (form/submit-button {:class "btn btn-default"} "Upload"))]]
-      [:div.col-md-6
-       [:div.well
-        [:h2 "Upload Gesamtkatalog Spiele"]
-        (when (seq errors)
-          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
-        (form/form-to
-         {:enctype "multipart/form-data"
-          :class "form-inline"}
-         [:post (format "/%s/%s/%s/upload-confirm" year issue (name :ludo))]
-         (anti-forgery-field)
-         (form/file-upload "file")
-         " "
-         (form/submit-button {:class "btn btn-default"} "Upload"))]]]
-     [:div.row
-      [:div.col-md-6
-       [:div.well
-        [:h2 "Upload Gesamtkatalog Taktile Bücher"]
-        (when (seq errors)
-          [:p [:ul.alert.alert-danger (for [e errors] [:li e])]])
-        (form/form-to
-         {:enctype "multipart/form-data"
-          :class "form-inline"}
-         [:post (format "/%s/%s/%s/upload-confirm" year issue (name :taktilesbuch))]
-         (anti-forgery-field)
-         (form/file-upload "file")
-         " "
-         (form/submit-button {:class "btn btn-default"} "Upload"))]]])))
+       (upload-well "Upload Gesamtkatalog Hörfilm"
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :hörfilm))
+                    errors)]
+      [:div.col-md-6
+       (upload-well "Upload Gesamtkatalog Spiele"
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :ludo))
+                    errors)]]
+     [:div.row
+      [:div.col-md-6
+       (upload-well "Upload Gesamtkatalog Taktile Bücher"
+                    (format "/%s/%s/%s/upload-confirm" year issue (name :taktilesbuch))
+                    errors)]])))

 (defn editorial-form [request fmt year issue]
   (let [identity (friend/identity request)


checkpoint

checkpoint

Signed-off-by: Eric Baur <a1c9c5f8609c68027db0779b39e5f932d4cb0053@robeybaur.org>

--- src/obcc/core.clj
+++ src/obcc/core.clj
@@ -45,6 +45,7 @@
 (defn -app [& args]
   (let [ {:keys [options arguments errors summary]} (parse-opts args cli-options) ]
     (cond
+
       (:help options)
       (exit 0 (usage summary))


Disable on-start for touch devices for now

--- src/chessground/drag.cljs
+++ src/chessground/drag.cljs
@@ -18,14 +18,15 @@

 (defn- on-start [_ _ pointer]
   "Shift piece right under the cursor"
-  (let [$el ($ (get-target pointer))
-        pos (.offset $el)
-        center-x (+ (.-left pos) (/ (.width $el) 2))
-        center-y (+ (.-top pos) (/ (.height $el) 2))
-        decay-x (- (.-pageX pointer) center-x)
-        decay-y (- (.-pageY pointer) center-y)]
-    (jq/css $el {:left (str decay-x "px") :top (str decay-y "px")})
-    (highlight-square (jq/parent $el))))
+  (when (false? (common/is-touch-device))
+    (let [$el ($ (get-target pointer))
+          pos (.offset $el)
+          center-x (+ (.-left pos) (/ (.width $el) 2))
+          center-y (+ (.-top pos) (/ (.height $el) 2))
+          decay-x (- (.-pageX pointer) center-x)
+          decay-y (- (.-pageY pointer) center-y)]
+      (jq/css $el {:left (str decay-x "px") :top (str decay-y "px")})
+      (highlight-square (jq/parent $el)))))

 (defn- on-move [_ _ pointer]
   "Highlight the square under the dragged piece"
@@ -37,7 +38,7 @@
   (q/wrapper component
              :onMount (fn [node]
                         (-> (new js/Draggabilly node)
-                            ; (.on "dragStart" on-start)
+                            (.on "dragStart" on-start)
                             (.on "dragStart" (push-args! (:drag-start channels)))
                             (.on "dragMove" on-move)
                             (.on "dragEnd" (push-args! (:drag-end channels)))))))


connecting to cassandra with cassandrathrift

--- src/ophion/db.clj
+++ src/ophion/db.clj
@@ -12,7 +12,7 @@
 (defn connect-janus
   [{:keys [host keyspace] :as config}]
   (let [base (BaseConfiguration.)]
-    (.setProperty base "storage.backend" "cassandra")
+    (.setProperty base "storage.backend" "cassandrathrift")
     (.setProperty base "storage.hostname" (or (name host) "localhost"))
     (.setProperty base "storage.cassandra.keyspace" (or (name keyspace) "ophion"))
     (JanusGraphFactory/open base)))


* src/clj/cljs/compiler.clj: generated line is implicit. add :file info

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -244,7 +244,7 @@
                (swap! *cljs-mappings*
                       (fn [lines]
                         (let [last (conj (peek lines)
-                                         {:gline (count lines)
+                                         {:file *cljs-file*
                                           :gcol *cljs-gen-col*
                                           :line (when m (:line m))
                                           :col 0


Apply Rich's suggested improvements. Refs #38

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -520,9 +520,8 @@
     (let [name (munge (:name (resolve-var (dissoc env :locals) sym)))
           init-expr (when (contains? args :init) (disallowing-recur
                                                   (analyze (assoc env :context :expr) (:init args) sym)))
-          export-as (when (contains? (meta sym) :export)
-                      (let [export-val (-> sym meta :export)]
-                        (if (string? export-val) export-val name)))]
+          export-as (when-let [export-val (-> sym meta :export)]
+                      (if (= true export-val) name export-val))]
       (swap! namespaces assoc-in [(-> env :ns :name) :defs sym] name)
       (merge {:env env :op :def :form form
               :name name :doc (:doc args) :init init-expr}


Fix index creation

Fix index creation

--- src/clj/subman/models.clj
+++ src/clj/subman/models.clj
@@ -27,18 +27,19 @@
 (defn create-index
   "Create database index for subtitles"
   []
-  (esi/create const/index-name :mappings {"subtitle"
-                                          {:properties {:show {:type "string"}
-                                                        :season {:type "string"
-                                                                 :index "not_analyzed"}
-                                                        :episode {:type "string"
-                                                                  :index "not_analyzed"}
-                                                        :name {:type "string"}
-                                                        :lang {:type "string"}
-                                                        :version {:type "string"}
-                                                        :url {:type "string"
-                                                              :index "not_analyzed"}
-                                                        :source {:type "integer"}}}}))
+  (esi/create @connection const/index-name
+              :mappings {"subtitle"
+                         {:properties {:show {:type "string"}
+                                       :season {:type "string"
+                                                :index "not_analyzed"}
+                                       :episode {:type "string"
+                                                 :index "not_analyzed"}
+                                       :name {:type "string"}
+                                       :lang {:type "string"}
+                                       :version {:type "string"}
+                                       :url {:type "string"
+                                             :index "not_analyzed"}
+                                       :source {:type "integer"}}}}))

 (defn create-document
   "Put document into elastic"


Ensure Socket Timeout is set for BasicHttpClientConnectionManager

Addresses #462

--- src/clj_http/conn_mgr.clj
+++ src/clj_http/conn_mgr.clj
@@ -4,7 +4,7 @@
             [clojure.java.io :as io])
   (:import (java.net Socket Proxy Proxy$Type InetSocketAddress)
            (java.security KeyStore)
-           (org.apache.http.config RegistryBuilder Registry)
+           (org.apache.http.config RegistryBuilder Registry SocketConfig)
            (org.apache.http.conn HttpClientConnectionManager)
            (org.apache.http.conn.ssl DefaultHostnameVerifier
                                      NoopHostnameVerifier
@@ -181,15 +181,22 @@
         (.build))))

 (defn ^BasicHttpClientConnectionManager make-regular-conn-manager
-  [{:keys [keystore trust-store] :as req}]
-  (cond
-    (or keystore trust-store)
-    (BasicHttpClientConnectionManager. (get-keystore-scheme-registry req))
-
-    (opt req :insecure) (BasicHttpClientConnectionManager.
-                         @insecure-scheme-registry)
-
-    :else (BasicHttpClientConnectionManager. regular-scheme-registry)))
+  [{:keys [keystore trust-store socket-timeout] :as req}]
+  (let [conn-manager (cond
+                       (or keystore trust-store)
+                       (BasicHttpClientConnectionManager. (get-keystore-scheme-registry req))
+
+                       (opt req :insecure) (BasicHttpClientConnectionManager.
+                                            @insecure-scheme-registry)
+
+                       :else (BasicHttpClientConnectionManager. regular-scheme-registry))]
+    (when socket-timeout
+      (.setSocketConfig conn-manager
+                        (-> (.getSocketConfig conn-manager)
+                            (SocketConfig/copy)
+                            (.setSocketTimeout socket-timeout) ;modify only the socket-timeout
+                            (.build))))
+    conn-manager))

 (defn- ^DefaultConnectingIOReactor make-ioreactor
   [{:keys [connect-timeout interest-op-queued io-thread-count rcv-buf-size


Store dates in date format, unparse when displayed.

--- src/cljs/tunnit/core.cljs
+++ src/cljs/tunnit/core.cljs
@@ -48,7 +48,7 @@
   (let [today-nr (week-day-nr (t/now))
         date (t/minus (t/now)
                       (t/days (- today-nr k)))]
-    [k (assoc v :date (unparse-date date))]
+    [k (assoc v :date date)]
     ))

 (defn week-dates []
@@ -59,7 +59,7 @@
                       (ot/div
                         (map (fn [day]
                                (ot/output {:class "day-label"}
-                                          (str (:name day) " " (:date day))))
+                                          (str (:name day) " " (unparse-date (:date day)))))
                              (vals (week-dates)))
                         )))


add extra ns-alias for reader required by some old version

--- src/cljs_api_gen/read.clj
+++ src/cljs_api_gen/read.clj
@@ -19,6 +19,7 @@
     (if-let [f (try (binding [reader/*data-readers* *cljs-data-readers*
                               reader/*alias-map* '{ana cljs.analyzer
                                                    s cljs.spec.alpha
+                                                   spec cljs.spec
                                                    stc cljs.test.check
                                                    env cljs.env
                                                    comp cljs.compiler}]


more senta fixes

more senta fixes

--- src/pc/server.clj
+++ src/pc/server.clj
@@ -1,5 +1,6 @@
 (ns pc.server
-  (:require [clojure.tools.logging :as log]
+  (:require [clojure.core.async :as async]
+            [clojure.tools.logging :as log]
             [clojure.tools.reader.edn :as edn]
             [clj-time.core :as time]
             [compojure.core :refer (defroutes routes GET POST ANY)]
@@ -15,8 +16,8 @@
             [stefon.core :as stefon]
             [taoensso.sente :as sente]))

-;; TODO: find a way to restart sensa
-(defonce sensa-fns (atom {}))
+;; TODO: find a way to restart senta
+(defonce senta-state (atom {}))

 (defn log-request [req resp ms]
   (when-not (re-find #"^/cljs" (:uri req))
@@ -33,7 +34,7 @@
           (log/error e)))
       resp)))

-(defn app [sensa-fns]
+(defn app [senta-state]
   (routes
    (POST "/api/entity-ids" request
          (datomic/entity-id-request (-> request :body slurp edn/read-string :count)))
@@ -47,8 +48,8 @@
    (GET "/" [] (content/app))
    (compojure.route/resources "/" {:root "public"
                                    :mime-types {:svg "image/svg"}})
-   (GET "/chsk" req ((:ajax-get-or-ws-handshake-fn sensa-fns) req))
-   (POST "/chsk" req ((:ajax-post-fn sensa-fns) req))
+   (GET "/chsk" req ((:ajax-get-or-ws-handshake-fn senta-state) req))
+   (POST "/chsk" req ((:ajax-post-fn senta-state) req))
    (ANY "*" [] {:status 404 :body nil})))

 (defn port []
@@ -56,8 +57,8 @@
     (Integer/parseInt (System/getenv "HTTP_PORT"))
     8080))

-(defn start [sensa-fns]
-  (def server (httpkit/run-server (-> (app sensa-fns)
+(defn start [senta-state]
+  (def server (httpkit/run-server (-> (app senta-state)
                                       (logging-middleware)
                                       (site)
                                       (stefon/asset-pipeline pc.stefon/stefon-options))
@@ -68,13 +69,32 @@

 (defn restart []
   (stop)
-  (start @sensa-fns))
+  (start @senta-state))

-(defn sensa-init []
+(defn user-id-fn [ring-req]
+  (println "calling user-id-fn")
+  (println (get-in ring-req [:params :test]))
+  (get-in ring-req [:params :test]))
+
+(defn ws-handler [req]
+  (def req req)
+  (log/info (:event req)))
+
+(defn setup-ws-handlers [senta-state]
+  (let [tap (async/chan (async/sliding-buffer 100))
+        mult (async/mult (:ch-recv senta-state))]
+    (async/tap mult tap)
+    (async/go-loop []
+                   (when-let [req (async/<! tap)]
+                     (ws-handler req)
+                     (recur)))))
+
+(defn senta-init []
   (let [{:keys [ch-recv send-fn ajax-post-fn connected-uids
-                ajax-get-or-ws-handshake-fn] :as fns} (sente/make-channel-socket! {})]
-    (reset! sensa-fns fns)))
+                ajax-get-or-ws-handshake-fn] :as fns} (sente/make-channel-socket! {:user-id-fn #'user-id-fn})]
+    (reset! senta-state fns)
+    (setup-ws-handlers fns)))

 (defn init []
-  (sensa-init)
-  (start @sensa-fns))
+  (senta-init)
+  (start @senta-state))


system: Start figwheel with the system.

system: Start figwheel with the system.

--- src/pepa/core.clj
+++ src/pepa/core.clj
@@ -12,8 +12,9 @@
             [pepa.zeroconf :as zeroconf]
             [pepa.systemd :as systemd]
             [pepa.init :as init]
+            [pepa.log :refer [wrap-logging]]

-            [pepa.log :refer [wrap-logging]]
+            [figwheel-sidecar.system :as fig]

             [clojure.core.match :refer [match]])
   (:gen-class))
@@ -46,7 +47,9 @@
        :zeroconf (component/using
                   (zeroconf/make-component)
                   [:config])
-       :systemd (systemd/make-component))
+       :systemd (systemd/make-component)
+
+       :figwheel-system (fig/figwheel-system (fig/fetch-config)))
       (wrap-logging)))

 (defn -main [& args]


single-language generation

single-language generation

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -29,18 +29,19 @@
    (exec-raw [(str "TRUNCATE " table)])))
 ;; catch exceptions when trying to populate

-(defn expression-single [model spec]
+(defn expression [model spec]
   (let [no-language (if (nil? model)
                              (throw (Exception. "No target language model was supplied.")))
-
-        ;; 1. generate sentence in target language.
-        ;; resolve future
         model (if (future? model)
                 @model
                 model)

         sentence (engine/generate spec model :enrich true)
-
+
+        check (if (nil? sentence)
+                (throw (Exception. (str "Could not generate a sentence for spec: " spec " for language: " (:language model)
+                                        " with model named: " (:name model)))))
+
         sentence (if (:morph-walk-tree model)
                    (merge ((:morph-walk-tree model) sentence)
                           sentence)
@@ -57,7 +58,7 @@
                                   {:synsem {:sem {:subj subj}}}))
                          true
                          sentence))]
-    {:target sentence}))
+    sentence))

 (defn expression-pair [source-language-model target-language-model spec]
   "Generate a pair: {:source <source_expression :target <target_expression>}.
@@ -66,7 +67,7 @@

    Then, the source expression is generated according to the semantics of this target expression.

-   Thus the source expression's spec is not specified directly - rather it is derived from the
+   Thus the source expression's spec is not specified directly - rather it is derived from the
    semantics of the target expression."

   (let [no-source-language (if (nil? source-language-model)
@@ -98,32 +99,27 @@
                                                   {:synsem {:sem {:subj subj}}}))
                                          true
                                          target-language-sentence))
-
-        error (if (nil? target-language-sentence)
-                (let [message (str "Could not generate a sentence in target language '"
-                                   (:language target-language-model)
+        target-fo (:morph target-language-model)
+
+        semantics (strip-refs (get-in target-language-sentence [:synsem :sem] :top))
+
+        ;; 2. generate sentence in source language using semantics of sentence in target language.
+        ;; resolve future
+        source-language-model (if (future? source-language-model)
+                                @source-language-model
+                                source-language-model)
+        debug (log/debug (str "semantics of resulting expression: " semantics))
+        debug (log/trace (str "entire expression: " target-language-sentence))
+
+        target-language-surface (target-fo target-language-sentence)
+        debug (log/debug (str "target surface: " target-language-surface))
+
+        source-language (:language source-language-model)
+        error (if (or (nil? target-language-surface)
+                      (= target-language-surface ""))
+                (let [message (str "Could not generate a sentence in source language '"
+                                   (:language source-language-model)
                                    "' for this spec: " spec)]
-                  (if (= true mask-populate-errors)
-                    (log/warn message)
-                    ;; else
-                    (let [target-language-model target-language-model]
-                      (log/error message)
-                      (log/error "grammar: " (map :rule (:grammar target-language-model)))
-                      (log/error "lexicon: " (string/join "," (map (:morph target-language-model)
-                                                                   (sort (keys (:lexicon target-language-model))))))
-                      ;; TODO: add partial parses for more diagnostics:
-                      ;; need to try parsing same spec, but without the
-                      ;;  {:synsem {:subcat '()}} that makes us try to generate
-                      ;; an entire sentence.
-                      (throw (Exception. message))))))
-
-        target-fo (:morph target-language-model)
-        target-language-surface (target-fo target-language-sentence)
-        semantics (strip-refs (get-in target-language-sentence [:synsem :sem] :top))
-
-        error (if (or (nil? target-language-surface)
-                      (empty? target-language-surface))
-                (let [message (str "Surface of target sentence was empty - spec was: " spec "; target-language-sentence was: " target-language-sentence)]
                   (if (= true mask-populate-errors)
                     (log/warn message)
                     ;; else
@@ -137,20 +133,6 @@
                       ;;  {:synsem {:subcat '()}} that makes us try to generate
                       ;; an entire sentence.
                       (throw (Exception. message))))))
-
-        debug (log/debug (str "target surface  : " target-language-surface))
-        debug (log/debug (str "target-semantics:" semantics))
-
-        ;; 2. generate sentence in source language using semantics of sentence in target language.
-        ;; resolve future
-        source-language-model (if (future? source-language-model)
-                                @source-language-model
-                                source-language-model)
-        debug (log/debug (str "semantics of resulting expression: " semantics))
-        debug (log/trace (str "entire expression: " target-language-sentence))
-
-
-        source-language (:language source-language-model)
         ;; TODO: add warning if semantics of target-expression is merely :top - it's
         ;; probably not what the caller expected. Rather it should be something more
         ;; specific, like {:pred :eat :subj {:pred :antonio}} ..etc.
@@ -224,6 +206,30 @@
                [canonical (str (serialize lexeme))
                 language]]))

+(defn populate-with-language [num model spec]
+  (let [spec (if spec spec :top)
+        language (:language model)
+        debug (log/debug (str "populate-with-language: spec: " spec "; language: " language))]
+    (dotimes [n num]
+      (let [sentence (expression model spec)
+            fo (:morph model)
+            surface (fo sentence)]
+        (if (empty? surface)
+          (let [err-mesg (str "Surface was empty for expression generated from spec: " spec)]
+            (log/error err-mesg)
+            (log/error (str " expression with empty surface has structure: " (strip-refs sentence)))
+            (throw (Exception. err-mesg))))
+        (log/info (str "populate-with-language:" language ": surface='"
+                       surface "'"))
+        (log/debug (str "populate-with-language:" language ": spec='"
+                       spec "'"))
+        (insert-expression sentence ;; underlying structure
+                           surface ;; text of expression
+                           "expression" ;; table in database
+                           language
+                           (:name model)) ;; name of language model; e.g.: 'small','medium'
+        ))))
+
 ;; TODO: use named optional parameters.
 (defn populate [num source-language-model target-language-model & [ spec table ]]
   (let [spec (if spec spec :top)
@@ -294,6 +300,7 @@
   "choose one random member from target-lex-set and one from target-grammar-set, and populate from this pair"
   (let [lex-spec (nth target-lex-set (rand-int (.size target-lex-set)))
         grammar-spec (nth target-grammar-set (rand-int (.size target-grammar-set)))]
+    (populate 1 source-language-model target-language-model (unify lex-spec grammar-spec))))

 (defn fill-by-spec [spec count table source-model target-model]
   (if (nil? source-model)
@@ -316,7 +323,7 @@
         (log/debug (str "There are already " current-target-count " expressions for: " spec)))
       (if (> count 0)
         (do
-          (log/info (str "Generating "
+          (log/debug (str "Generating "
                          count
                          (if (> current-target-count 0) " more")
                          " expressions for spec: " spec))
@@ -327,10 +334,15 @@
           (fill-by-spec spec (- count 1) table source-model target-model))
         (log/debug (str "Since no more are required, not generating any for this spec."))))))

-(defn fill-one-language [spec count table model]
-  (let [language (:language @model)
+(defn fill-language-by-spec [spec count table model]
+  (let [model (if (future? model)
+                @model
+                model)
+        language (:language model)
+        debug (log/debug (str "THE LANGUAGE IS : " language))
+        debug (log/debug (str "THE SPEC IS : " spec))
         json-spec (json/write-str spec)
-        current-target-count
+        current-count
         (:count
          (first
           (exec-raw ["SELECT count(*) FROM expression
@@ -338,21 +350,19 @@
                            AND language=?"
                        [(json/write-str spec) language]]
                       :results)))]
-    (log/debug (str "current-target-count for spec: " spec "=" current-target-count))
-    (let [count (- count current-target-count)]
-      (if (> current-target-count 0)
-        (log/debug (str "There are already " current-target-count " expressions for: " spec " in language: " language)))
+    (log/debug (str "current-count for spec: " spec "=" current-count))
+    (let [count (- count current-count)]
+      (if (> current-count 0)
+        (log/debug (str "There are already " current-count " expressions for: " spec)))
       (if (> count 0)
         (do
-          (log/info (str "Generating "
+          (log/debug (str "Generating "
                          count
-                         (if (> current-target-count 0) " more")
+                         (if (> current-count 0) " more")
                          " expressions for spec: " spec))
-          (populate-one-language 1
-                                 model
-                                 spec table)
-          (fill-one-language spec (- count 1) table model))
-        (log/debug (str "Since no more are required, not generating any for this spec in language: " language))))))
+          (populate-with-language 1 model spec)
+          (fill-language-by-spec spec (- count 1) table model))
+        (log/debug (str "Since no more are required, not generating any for this spec."))))))

 (defn fill-verb [verb count source-model target-model & [spec table]] ;; spec is for additional constraints on generation.
   (let [spec (if spec spec :top)
@@ -463,17 +473,6 @@
                         (log/debug (str "doing sql: " (:sql member-of-unit)))
                         (exec-raw (:sql member-of-unit))))

-
-                    (if (:fill-one-language member-of-unit)
-                      (let [count (or (->> member-of-unit :fill-one-language :count) 10)]
-                        (log/debug (str "doing fill-one-language: " (->> member-of-unit :fill-one-language :spec)
-                                        "; count=" count))
-                        (fill-one-language
-                         (->> member-of-unit :fill-one-language :spec)
-                         count
-                         "expression_import"
-                         (->> member-of-unit :fill-one-language :model))))
-
                     (if (:fill member-of-unit)
                       (let [count (or (->> member-of-unit :fill :count) 10)]
                         (log/debug (str "doing fill-by-spec: " (->> member-of-unit :fill :spec)
@@ -484,6 +483,15 @@
                          "expression_import"
                          (->> member-of-unit :fill :source-model)
                          (->> member-of-unit :fill :target-model))))
+                    (if (:fill-with-language member-of-unit)
+                      (let [count (or (->> member-of-unit :fill-with-language :count) 10)]
+                        (log/debug (str "doing fill-with-language: " (->> member-of-unit :fill-with-language :spec)
+                                        "; count=" count))
+                        (fill-language-by-spec
+                         (->> member-of-unit :fill-with-language :spec)
+                         count
+                         "expression_import"
+                         (->> member-of-unit :fill-with-language :model))))
                     (if (:fill-verb member-of-unit)
                       (do
                         (log/info (str "Doing fill-verb: " (:fill-verb member-of-unit)))


Cleanup docstrings in CLJS dom ns.

Cleanup docstrings in CLJS dom ns.

--- src/cljs/c2/dom.cljs
+++ src/cljs/c2/dom.cljs
@@ -7,19 +7,25 @@
             [goog.dom.classes :as gclasses]
             [goog.style :as gstyle]))

-;; From Weavejester's Hiccup.
-(def ^{:doc "Regular expression that parses a CSS-style id and class from a tag name."}
-  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
-
+;; Regular expression that parses a CSS-style id and class from a tag name. From Weavejester's Hiccup.
+(def re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")
+
+;;Namespace URIs
 (def xmlns {:xhtml "http://www.w3.org/1999/xhtml"
             :svg "http://www.w3.org/2000/svg"})

+;;Common SVG tags; DOM node creation fn checks this set to infer element namespace (so users don't have to write things like [:svg:rect]).
 (def svg-tags #{:svg :g :rect :circle :clipPath :path :line :polygon :polyline :text :textPath})

-(defn dom-element? [x]
+
+(defn dom-element?
+  "Live DOM elements have JavaScript nodeName defined."
+  [x]
   (not (undefined? (.-nodeName x))))

-(defn node-type [node]
+(defn node-type
+  "Check node type; used as a dispatch fn."
+  [node]
   (cond
    (vector? node)      :hiccup   ;;Hiccup vector
    (map? node)         :chiccup  ;;Hiccup map representation
@@ -27,25 +33,33 @@
    (dom-element? node) :dom      ;;It's an actual DOM node
    ))

-(defmulti select node-type)
+(defmulti select
+  "Select a single DOM node via CSS selector, optionally scoped by second arg.
+   If passed live DOM node, just return it."
+  node-type)
 (defmethod select :selector
   ([selector] (.querySelector js/document selector))
   ([selector container] (.querySelector (select container) selector)))
 (defmethod select :dom [node] node)

-(defmulti select-all node-type)
+(defmulti select-all
+  "Like select, but returns a collection of nodes."
+  node-type)
 (defmethod select-all :selector
   ([selector] (.querySelectorAll js/document selector))
   ([selector container] (.querySelectorAll (select container) selector)))
 (defmethod select-all :dom [nodes] nodes)

-
-(defn children [node]
+(defn children
+  "Return the children of a live DOM element."
+  [node]
   (filter #(= 1 (.-nodeType %))
           (.-childNodes (select node))))

-(defn parent [node]
+(defn parent
+  "Return parent of a live DOM node."
+  [node]
   (.-parentNode (select node)))

@@ -54,43 +68,81 @@
 (declare canonicalize)

-(defn append! [container el]
+(defn append!
+  "Make element last child of container.
+   Returns live DOM node.
+   > *container* CSS selector or live DOM node
+   > *el* hiccup vector"
+  [container el]
   (let [el (if (dom-element? el)
              el
              (build-dom-elem el))]
     (gdom/appendChild (select container) el)
     el))

-(defn prepend! [container el]
+(defn prepend!
+  "Make element first child of container.
+   Returns live DOM node.
+   > *container* CSS selector or live DOM node
+   > *el* hiccup vector"
+  [container el]
   (let [el (if (dom-element? el)
              el
              (build-dom-elem el))]
     (gdom/insertChildAt (select container) el 0)
     el))

-(defn remove! [el]
+(defn remove!
+  "Remove element from DOM and return it.
+   > *el* CSS selector or live DOM node"
+  [el]
   (gdom/removeNode (select el)))

-(defn replace! [old new]
-  (let [new (if (dom-element? new)
-              new
-              (build-dom-elem new))]
+(defn replace!
+  "Replace live DOM node with a new one.
+   > *old* CSS selector or live DOM node
+   > *new* CSS selector, live DOM node, or hiccup vector"
+  [old new]
+  (let [new (condp = (node-type new)
+              :dom new
+              :hiccup (build-dom-elem new)
+              :selector (select new))]
     (gdom/replaceNode new (select old))))

 (defn style
+  "Get or set inline element style.
+
+   `(style el)`                map of inline element styles
+
+   `(style el :keyword)`       value of style :keyword
+
+   `(style el {:keyword val})` sets inline style according to map, returns element
+
+   `(style el :keyword val)`   sets single style, returns element"
   ([el] (throw (js/Error. "TODO: return map of element styles")))
   ([el x] (match [x]
                  [(k :when keyword?)] (gstyle/getComputedStyle el (name k))
-                 [(m :when map?)] (doseq [[k v] m] (style el k v))))
+                 [(m :when map?)] (doseq [[k v] m] (style el k v)))
+     el)
   ([el k v] (gstyle/setStyle el (name k)
                              (match [v]
                                     [s :when string?] s
                                     [n :when number?]
                                     (if (#{:height :width :top :left :bottom :right} (keyword k))
                                       (str n "px")
-                                      n)))))
+                                      n)))
+     el))

 (defn attr
+  "Get or set element attributes.
+
+   `(attr el)`                map of element attributes
+
+   `(attr el :keyword)`       value of attr :keyword
+
+   `(attr el {:keyword val})` sets element attributes according to map, returns element
+
+   `(attr el :keyword val)`   sets single attr, returns element"
   ([el] (let [attrs (.-attributes el)]
           (into {} (for [i (range (.-length attrs))]
                      [(keyword  (.-name (aget attrs i)))
@@ -103,11 +155,15 @@
        (style el v)
        (.setAttribute el (name k) v))))

-(defn text [el v]
-  (gdom/setTextContent el v))
+(defn text
+  "Get or set element text."
+  ([el]
+     (gdom/getTextContent (select el)))
+  ([el v]
+     (gdom/setTextContent (select el) v)))

 (defn classed!
-  "Adds or removes `class` to `el` based on boolean `classed?`."
+  "Add or remove `class` to `el` based on boolean `classed?`."
   [el class classed?]
   (gclasses/enable (select el) class classed?))

@@ -115,33 +171,38 @@
 (defn add-class! [el class] (classed! el class true))
 (defn remove-class! [el class] (classed! el class false))

+
+;;Call this fn with a fn that should be executed on the next browser animation frame.
 (def request-animation-frame
   (or (.-requestAnimationFrame js/window)
       (.-webkitRequestAnimationFrame js/window)
       #(timeout 10 (%))))

 (defn merge-dom!
-  "Walks an existing dom-node and makes sure that it has the same attributes and children as the given el."
-  [dom-node el & {:keys [defer-attr]
-                  :or {defer-attr false}}]
+  "Recursively walk a live DOM node, unifying its attributes and children with those of hiccup vector `el`.
+   Boolean kwarg `:defer-attr` to set attributes on next animation frame, defaults to `false`. "
+  [$node el & {:keys [defer-attr]
+               :or {defer-attr false}}]
   (let [el (canonicalize el)]
-    (when (not= (.toLowerCase (.-nodeName dom-node))
+    (when (not= (.toLowerCase (.-nodeName $node))
                 (.toLowerCase (name (:tag el))))
       (throw "Cannot merge el into node of a different type"))
-
+
     (if defer-attr
-      (request-animation-frame #(attr dom-node (:attr el)) dom-node)
-      (attr dom-node (:attr el)))
+      (request-animation-frame #(attr $node (:attr el)) $node)
+      (attr $node (:attr el)))

     (when-let [txt (first (filter string? (:children el)))]
-      (text dom-node txt))
-    (iter {for [dom-child el-child] in (map vector (children dom-node)
+      (text $node txt))
+    (iter {for [dom-child el-child] in (map vector (children $node)
                                             (remove string? (:children el)))}
           (merge-dom! dom-child el-child :defer-attr defer-attr))
-    dom-node))
+    $node))

 (defn canonicalize
-  "Parse hiccup-like vec into map of {:tag :attr :children}, or return string as itself.
+  "Convert hiccup vectors into maps suitable for rendering.
+   Hiccup vectors will be converted to maps of {:tag :attr :children}.
+   Strings will be passed through and numbers coerced to strings.
    Based on Pinot's html/normalize-element."
   [x]
   (match [x]
@@ -164,10 +225,10 @@
                                                                   {:id (or id nil)
                                                                    :class (if class (string/replace class #"\." " "))}))
                                    map-attrs        (first content)]
-
+
                                (let [[attr raw-children] (if (map? map-attrs)
-                                                                [(merge tag-attrs map-attrs) (next content)]
-                                                                [tag-attrs content])
+                                                           [(merge tag-attrs map-attrs) (next content)]
+                                                           [tag-attrs content])
                                      ;;Explode children seqs in place
                                      children (mapcat #(if (and (not (vector? %)) (seq? %))
                                                          (map canonicalize %)
@@ -178,7 +239,9 @@
 (defn create-elem [nsp tag]
   (.createElementNS js/document nsp (name tag)))

-(defn build-dom-elem [el]
+(defn build-dom-elem
+  "Build live DOM element from hiccup vector, hiccup map, or string."
+  [el]
   (match [el]
          [(s :when string?)] (gdom/createTextNode s)
          [(v :when vector?)] (recur (canonicalize v))


gen images turned off

gen images turned off

--- src/meta_doc/gen_images.clj
+++ src/meta_doc/gen_images.clj
@@ -14,7 +14,7 @@
             [clojure2d.extra.raymarching :as r]
             [clojure2d.extra.segmentation :as segm]))

-(def ^:dynamic *generate-images* true)
+(def ^:dynamic *generate-images* false)

 (defn draw-example
   "Draw example on canvas."


Make it possible to pass in vars to scp.

--- src/control/core.clj
+++ src/control/core.clj
@@ -16,7 +16,7 @@
 		err (reader (.getErrorStream process) :encoding "UTF-8")
 		execp (struct ExecProcess process in err)
 		pagent (agent execp)]
-	(send-off pagent (fn [exec-process] (assoc exec-process :stdout (str (:stdout exec-process) (join "\r\n" (doall (line-seq in)))))))
+	(send-off pagent (fn [exec-process] (assoc exec-process :stdout (str (:stdout exec-process) (join "\r\n" (doall (line-seq in)))))))
 	(send-off pagent (fn [exec-process] (assoc exec-process :stderr (str (:stderr exec-process) (join "\r\n" (doall (line-seq err)))))))
 	pagent))

@@ -55,13 +55,15 @@
 (defn ssh
   [host user cmd]
   (log-with-tag host "ssh" cmd)
-  (exec host user ["ssh" (ssh-client host user) cmd]))
+  (exec host user ["ssh" (ssh-client host user) cmd]))

 (defmacro scp
   [host user files remoteDir]
-  `(do (log-with-tag ~host "scp" (join " " (list ~@files  " ==> " ~remoteDir)))
-	   (exec ~host ~user ["scp" ~@files (str (ssh-client ~host ~user) ":"  ~remoteDir)])))
+  `(do (log-with-tag ~host "scp"
+         (join " " (concat ~files [ " ==> " ~remoteDir])))
+       (exec ~host ~user ["scp" ~@files (str (ssh-client ~host ~user) ":"
+                                             ~remoteDir)])))


btset fast range scans

btset fast range scans

--- src/datascript/btset.cljs
+++ src/datascript/btset.cljs
@@ -4,15 +4,34 @@
 (declare BTSet Node LeafNode)

 (def ^:const min-len nil) ;; FIXME
-(def ^:const max-len 128)
-(def ^:const path-bit-offset 8)
-(def ^:const path-mask (dec (bit-shift-left 1 path-bit-offset)))
+(def ^:const ^number max-len 128)
+(def ^:const ^number level-shift (->> (range 31 -1 -1)
+                              (filter #(bit-test max-len %))
+                              first
+                              inc))
+(def ^:const ^number path-mask (dec (bit-shift-left 1 level-shift)))
+(def ^:const ^number empty-path 0)
 (def ^:dynamic *cmp* compare)

-(defn eq [a b]  (== 0 (*cmp* a b)))
-(defn half [x]  (fix (/ x 2)))
-
-(defn binary-search ^number [^array arr ^number l ^number r k]
+(defn ^number path-get [^number path
+                        ^number level]
+  (bit-and path-mask
+           (unsigned-bit-shift-right path level)))
+
+(defn ^number path-set [^number path
+                        ^number level
+                        ^number idx]
+  (bit-or path
+          (bit-shift-left idx level)))
+
+(defn eq ^boolean [^number a
+                   ^number b]
+  (== 0 (*cmp* a b)))
+
+(defn ^number half [^number x]
+  (fix (/ x 2)))
+
+(defn ^number binary-search [^array arr ^number l ^number r k]
   (if (<= l r)
     (let [m   (half (+ l r))
           mk  (aget arr m)
@@ -22,32 +41,31 @@
         (pos? cmp) (recur arr l (dec m) k)
         :else m))
     l))
-
-(defn lookup ^number [^array arr key]
-  (binary-search arr 0 (dec (alength arr)) key))
-
-(defn -seek ^number [set key]
-  (loop [node (.-root set)
-         path  0
-         path-offset 0
-         depth 1]
-    (let [keys (.-keys node)
-          idx  (lookup keys key)]
-      (if (== depth (.-depth set))
-        (bit-or (bit-shift-left idx path-offset) path)
-        (let [idx (if (== idx (alength keys)) (dec idx) idx)]
-          (recur (aget (.-pointers node) idx)
-                 (bit-or (bit-shift-left idx path-offset) path)
-                 (+ path-offset path-bit-offset)
-                 (inc depth)))))))
-
-(defn seek [set key]
+
+(defn ^number lookup-leaf [^array arr key]
+  (binary-search arr 0 (- (alength arr) 1) key))
+
+(defn ^number lookup-node [^array arr key]
+  (binary-search arr 0 (- (alength arr) 2) key))
+
+(defn ^number -seek [set key]
+  (loop [node  (.-root set)
+         path  empty-path
+         level (.-shift set)]
+    (if (== 0 level)
+      (path-set path level (lookup-leaf (.-keys node) key))
+      (let [idx (lookup-node (.-keys node) key)]
+        (recur (aget (.-pointers node) idx)
+               (path-set path level idx)
+               (- level level-shift))))))
+
+(defn ^number seek [set key]
   (binding [*cmp* (.-comparator set)]
     (-seek set key)))

 ;; Array operations

-(defn cut-n-splice ^array [^array  arr
+(defn ^array cut-n-splice [^array  arr
                            ^number cut-from
                            ^number cut-to
                            ^number splice-from
@@ -73,20 +91,20 @@
   (^array [^array arr ^number cut-from ^number cut-to]
     (.slice arr cut-from cut-to)))

-(defn splice ^array [^array  arr
+(defn ^array splice [^array  arr
                      ^number splice-from
                      ^number splice-to
                      ^array  xs]
   (cut-n-splice arr 0 (alength arr) splice-from splice-to xs))

-(defn insert ^array [^array arr
+(defn ^array insert [^array arr
                      ^number idx
                      ^array xs]
   (cut-n-splice arr 0 (alength arr) idx idx xs))

 ;;

-(defn replace-keys ^array [^array old-keys ^number idx ^array new-keys]
+(defn ^array replace-keys [^array old-keys ^number idx ^array new-keys]
   (let [new-keys-l (alength new-keys)]
     (if (and (== 1 new-keys-l)
              (eq (aget new-keys 0) (nth old-keys idx)))
@@ -100,28 +118,12 @@

 (deftype Node [keys pointers]
   Object
-  (get_key [_ path]
-    (let [path-idx (bit-and path path-mask)
-          path-next (unsigned-bit-shift-right path path-bit-offset)]
-      (.get_key (aget pointers path-idx) path-next)))
-
-  (next_path [_ path]
-    (let [path-idx      (bit-and path path-mask)
-          path-next     (unsigned-bit-shift-right path path-bit-offset)
-          path-next-new (.next_path (aget pointers path-idx) path-next)]
-      (if (== -1 path-next-new)
-        (if (< (inc path-idx) (alength pointers))
-          (inc path-idx)  ;; keeping subpathes filled with 0
-          -1)
-        (bit-or path-idx
-                (bit-shift-left path-next-new path-bit-offset)))))
-
-  (append [_ path key]
-    (let [path-idx  (bit-and path path-mask)
-          path-next (unsigned-bit-shift-right path path-bit-offset)
-          nodes     (.append (aget pointers path-idx) path-next key)
-          new-keys     (replace-keys keys     path-idx                (.map nodes lim-key))
-          new-pointers (splice       pointers path-idx (inc path-idx) nodes)]
+
+  (append [_ path level key]
+    (let [idx          (path-get path level)
+          nodes        (.append (aget pointers idx) path (- level level-shift) key)
+          new-keys     (replace-keys keys     idx           (.map nodes lim-key))
+          new-pointers (splice       pointers idx (inc idx) nodes)]
       (if (<= (alength new-pointers) max-len)
         ;; ok as is
         #js [(Node. new-keys new-pointers)]
@@ -131,20 +133,13 @@
                       (cut new-pointers 0 middle))
                (Node. (cut new-keys     middle)
                       (cut new-pointers middle))])))))
-
+
 (deftype LeafNode [keys]
   Object
-  (get_key [_ path]
-    (when (< path (alength keys))
-      (aget keys path)))
-
-  (next_path [_ path]
-    (if (>= (inc path) (alength keys))
-      -1
-      (inc path)))
-
-  (append [_ ^number idx key]
-    (let [keys-l (alength keys)]
+
+  (append [_ ^number path _ key]
+    (let [idx    (path-get path 0)
+          keys-l (alength keys)]
       (if (== keys-l max-len)
         ;; splitting
         (let [middle (half (inc keys-l))]
@@ -158,39 +153,97 @@
         ;; ok as is
         #js [(LeafNode. (splice keys idx idx #js [key]))]))))

-(defn next-path [set path]
-  (.next_path (.-root set) path))
-
-(defn get-key [set path]
-  (.get_key (.-root set) path))
+(defn ^array keys-for [set ^number path]
+  (loop [level (.-shift set)
+         node  (.-root set)]
+    (if (pos? level)
+      (recur (- level level-shift) (aget (.-pointers node) (path-get path level)))
+      (.-keys node))))
+
+(defn key-for [set ^number path]
+  (let [keys (keys-for set path)
+        idx  (path-get path 0)]
+    (when (< idx (alength keys))
+      (aget keys idx))))

 (defn btset-conj [set key]
   (binding [*cmp* (.-comparator set)]
-    (let [roots (.append (.-root set) (-seek set key) key)]
+    (let [roots (.append (.-root set) (-seek set key) (.-shift set) key)]
       (if (== (alength roots) 1)
         ;; keeping single root
-        (BTSet. (aget roots 0) (.-depth set) *cmp*)
+        (BTSet. (aget roots 0) (.-shift set) *cmp*)
         ;; introducing new root
-        (BTSet. (Node. (.map roots lim-key) roots) (inc (.-depth set)) *cmp*)))))
-
-(deftype BTSetIter [set path]
+        (BTSet. (Node. (.map roots lim-key) roots) (+ (.-shift set) level-shift) *cmp*)))))
+
+;; iteration
+
+(defn ^number -next-path [node
+                          ^number path
+                          ^number level]
+  (let [idx (path-get path level)]
+    (if (pos? level)
+      ;; inner node
+      (let [sub-path (-next-path (aget (.-pointers node) idx) path (- level level-shift))]
+        (if (== -1 sub-path)
+          ;; nested node overflow
+          (if (< (inc idx) (alength (.-pointers node)))
+            ;; advance current node idx, reset subsequent indexes
+            (path-set empty-path level (inc idx))
+            ;; current node overflow
+            -1)
+          ;; keep current idx
+          (path-set sub-path level idx)))
+      ;; leaf
+      (if (< (inc idx) (alength (.-keys node)))
+        ;; advance leaf idx
+        (path-set empty-path 0 (inc idx))
+        ;; leaf overflow
+        -1))))
+
+(defn next-path [set path]
+  (-next-path (.-root set) path (.-shift set)))
+
+
+(deftype BTSetIter [^BTSet  set
+                    ^number path
+                    ^array  keys
+                    ^number idx]
   ISeqable
   (-seq [this]
-    (when-not (== -1 path)
-      this))
+    (when keys this))

   ISeq
   (-first [_]
-    (when-not (== -1 path)
-      (get-key set path)))
+    (when keys (aget keys idx)))

   (-rest [_]
-    (BTSetIter. set (next-path set path))))
-
-(deftype BTSet [root depth comparator]
+    (if (< (inc idx) (alength keys))
+      ;; can use cached array to move forward
+      (BTSetIter. set (inc path) keys (inc idx))
+      (let [path (next-path set path)]
+        (if (== -1 path)
+          (BTSetIter. set -1 nil -1)
+          (BTSetIter. set path (keys-for set path) (path-get path 0))))))
+
+  INext
+  (-next [_]
+    (if (< (inc idx) (alength keys))
+      ;; can use cached array to move forward
+      (BTSetIter. set (inc path) keys (inc idx))
+      (let [path (next-path set path)]
+        (when (not= -1 path)
+          (BTSetIter. set path (keys-for set path) (path-get path 0)))))))
+
+(defn btset-iter [set]
+  (when (pos? (alength (.-keys (.-root set))))
+    (BTSetIter. set empty-path (keys-for set empty-path) 0)))
+
+;; public interface
+
+(deftype BTSet [root shift comparator]
   Object
   (toString [this]
-    (pr-str (seq this)))
+    (pr-str* this))

   ICollection
   (-conj [set key] (btset-conj set key))
@@ -199,30 +252,43 @@
   (-lookup [set k]
     (-lookup set k nil))
   (-lookup [set k not-found]
-    (let [found (get-key set (seek set k))]
+    (let [found (key-for set (seek set k))]
       (if (eq found k) found not-found)))

   ISeqable
   (-seq [this]
-    (when (pos? (alength (.-keys root)))
-      (BTSetIter. this 0))))
+    (btset-iter this))
+
+  IPrintWithWriter
+  (-pr-writer [this writer opts]
+    (pr-sequential-writer writer pr-writer "#{" " " "}" opts (seq this))))
+
+(defn btset-by
+  ([cmp] (BTSet. (LeafNode. (array)) 0 cmp))
+  ([cmp & keys]
+    (reduce -conj (btset-by cmp) keys)))

 (defn btset
-  ([] (btset compare))
-  ([cmp]
-    (BTSet. (LeafNode. (array)) 1 cmp)))
+  ([] (btset-by compare))
+  ([& keys]
+    (reduce -conj (btset) keys)))

 ;; helpers

-(defn parse-path [path]
-  (loop [path path
-         res  []]
-    (if (not= path 0)
-      (recur (unsigned-bit-shift-right path path-bit-offset)
-             (conj res (bit-and path path-mask)))
-      res)))
-
-(def seek-h (comp parse-path seek))
+(defn parse-path [path shift]
+  (loop [level shift
+         res   []]
+    (if (pos? level)
+      (recur (- level level-shift)
+             (conj res (path-get path level))))))
+
+(defn seek-h [set key]
+  (parse-path (seek set key) (.-shift set)))
+
+;; (def s0 (apply btset (range 20000)))
+;; (def s1 (into (btset) (range 3)))
+;; (apply btset (range 150))
+

 (defn dump [node writer offset]
   (if (instance? LeafNode node)
@@ -236,11 +302,10 @@
       (-write writer "\n")
       (dump (aget (.-pointers node) i) writer (str "  " offset)))))

-(extend-type BTSet
-  IPrintWithWriter
-  (-pr-writer [o writer _]
-    (dump (.-root o) writer "")))
-
+;; (extend-type BTSet
+;;   IPrintWithWriter
+;;   (-pr-writer [o writer _]
+;;     (dump (.-root o) writer "")))

 (defn test-rand []
   (dotimes [i 100]
@@ -249,19 +314,21 @@
           s  (into (btset) xss)]
       (when-not (= (vec s) xs)
         (println xss))))
-  (println "Checked"))
+  (println "Checked")
+  :ok)

 ;; (test-rand)

 ;; perf

-(def test-matrix [:target  { "sorted-set" (sorted-set)
+(def test-matrix [:target  { ;; "sorted-set" (sorted-set)
                              "btset"      (btset)}
-                  :size    [100 500 1000 2000 5000 10000 20000 50000]
-;;                   :size    [100 500]
-                  :method  { ;; "conj"    (fn [opts] (into (:target opts) (:range opts)))
-                             ;; "lookup"  (fn [opts] (contains? (:set opts) (rand-int (:size opts))))
-                             "iterate" (fn [opts] (doseq [x (:set opts)] (+ 1 x))) }])
+;;                   :size    [100 500 1000 2000 5000 10000 20000 50000]
+                  :size    [100 500 20000]
+                  :method  { "conj"    (fn [opts] (into (:target opts) (:range opts)))
+                             "lookup"  (fn [opts] (contains? (:set opts) (rand-int (:size opts))))
+                             "iterate" (fn [opts] (doseq [x (:set opts)] (+ 1 x)))
+                            }])

 (defn test-setup [opts]
   (let [range (shuffle (range (:size opts)))]


Add keybinds for word-by-word caret movement actions

--- src/flense_nw/keymap.cljs
+++ src/flense_nw/keymap.cljs
@@ -18,6 +18,8 @@
    #{:left} (some-fn text/move-caret-left z/left-or-wrap)
    #{:right} (some-fn text/move-caret-right z/right-or-wrap)
    #{:up} (some-fn text/cease-editing completions/prev-completion z/up)
+   #{:alt :left} text/move-caret-left-by-word
+   #{:alt :right} text/move-caret-right-by-word
    #{:shift :left} (some-fn text/adjust-range-left z/prev)
    #{:shift :right} (some-fn text/adjust-range-right z/next)
    #{:meta :shift :k} model/prev-placeholder


Misused config here

Misused config here

--- src/foreclojure/users.clj
+++ src/foreclojure/users.clj
@@ -1,6 +1,6 @@
 (ns foreclojure.users
   (:use [foreclojure.utils   :only [from-mongo def-page row-class]]
-        [foreclojure.config  :only [config]]
+        [foreclojure.config  :only [config repo-url]]
         [somnium.congomongo  :only [fetch-one fetch]]
         [compojure.core      :only [defroutes GET]]
         [hiccup.page-helpers :only [link-to]]))
@@ -40,7 +40,7 @@
 (def-page users-page []
   [:div
    [:span.contributor "*"] " "
-   (link-to (:repo-url config) "4clojure contributor")]
+   (link-to repo-url "4clojure contributor")]
   [:br]
   [:table#user-table.my-table
    [:thead


DM + GR #76 - Refactor modal display to use context in objective template

--- src/objective8/templates/objective.clj
+++ src/objective8/templates/objective.clj
@@ -16,12 +16,14 @@
        "&body=" (translations :invitation-modal/email-body-line-1) " " (:title objective)
        "%0d%0d" (translations :invitation-modal/email-body-line-2) "%0d" (:invitation-url flash)))

-(defn writer-invitation-modal [flash objective translations]
-  (html/transformation
-    [:.clj-invitation-url] (html/set-attr "value" (:invitation-url flash))
-    [:.clj-mail-to] (html/set-attr :href (mail-to-string flash
-                                                         objective
-                                                         translations))))
+(defn writer-invitation-modal [{:keys [data doc translations] :as context}]
+  (let [objective (:objective data)
+        flash (:flash doc)]
+    (html/transformation
+     [:.clj-invitation-url] (html/set-attr "value" (:invitation-url flash))
+     [:.clj-mail-to] (html/set-attr :href (mail-to-string flash
+                                                          objective
+                                                          translations)))))

 (def invitation-response-snippet (html/select (html/html-resource "templates/jade/objective-invitation-response.html") [:.clj-invitation-response]))

@@ -48,6 +50,18 @@
                                                                                (html/set-attr :href (str "/sign-in?refer=" (:uri ring-request)))
                                                                                (tl8 :invitation-response/sign-in-to-accept))))))))))

+
+(def share-question-modal-snippet (html/select (html/html-resource "templates/jade/modals/share-question-modal.html")
+                                               [:.clj-share-question-modal]))
+
+(defn share-question-modal [{:keys [data] :as context}]
+  (when-let [question (:created-question data)]
+    (html/transformation [:clj-modal-contents]
+                         (html/content
+                          (html/at share-question-modal-snippet
+                                   [:.clj-modal-contents] identity)))))
+
+
 ;; DRAFTING HAS STARTED MESSAGE

 (def drafting-message-snippet (html/select pf/library-html-resource [:.clj-drafting-message]))
@@ -144,6 +158,7 @@
         objective-id (:_id objective)
         candidates (:candidates data)
         flash (:flash doc)
+        modal (:flash doc)
         optionally-disable-voting (if (tf/in-drafting? objective)
                                     (pf/disable-voting-actions translations)
                                     identity)]
@@ -161,8 +176,9 @@
                                                                (invitation-rsvp-for-objective? objective invitation-rsvp) (dissoc context :invitation-rsvp)
                                                                :else context)))
                                       [:.clj-modal-contents]
-                                      (if (= :invitation (:type flash))
-                                        (writer-invitation-modal flash objective translations)
+                                      (case (:type modal)
+                                        :invitation (writer-invitation-modal context)
+                                        :share-question (share-question-modal context)
                                         (when (invitation-rsvp-for-objective? objective invitation-rsvp)
                                           (invitation-rsvp-modal context)))


Fixed incorrect socket sending

Fixed incorrect socket sending

--- src/ardoq/swagger/api.clj
+++ src/ardoq/swagger/api.clj
@@ -40,11 +40,11 @@

 (defn version1 [client spec url name headers ignore-validate]
   (if ignore-validate
-    (do (socket-send "Ignoring validation - Importing Swagger 1" false)
+    (do (socket-send "Ignoring validation - Importing Swagger 1")
         (swagger/import-swagger client spec url name headers))
     (let [{:keys [success message]} (validate/validate-swagger "schemav1.json" (generate-string spec))]
       (if success
-        (do (socket-send "Valid Swagger - Importing Swagger 1" false)
+        (do (socket-send "Valid Swagger - Importing Swagger 1")
             (swagger/import-swagger client spec url name headers))
         (do (socket-close)
             (throw (ex-info  "InvalidSwagger" {:causes message})))))))


Remove one more character in remove-prefix-from-path.

This gets rid of a preceeding '/'

--- src/incise/utils.clj
+++ src/incise/utils.clj
@@ -8,7 +8,7 @@
   (-> afile
       (file)
       (.getCanonicalPath)
-      (subs (count (.getCanonicalPath prefix-file)))))
+      (subs (inc (count (.getCanonicalPath (file prefix-file)))))))

 (defn- gitignore-file? [^File file]
   (= (.getName file) ".gitignore"))


azulenoids.clj: refactored the traversal function

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -4,7 +4,16 @@
            (org.gavrog.joss.dsyms.generators CombineTiles DefineBranching2d))
   (:gen-class))

-;; General purpose functions
+;; General purpose definitions and entities
+
+(def empty-queue clojure.lang.PersistentQueue/EMPTY)
+
+(defn pop-while [pred coll]
+  "Like drop-while, but with pop."
+  (cond
+    (empty? coll) coll
+    (pred (first coll)) (recur pred (pop coll))
+    :else coll))

 (defn iterate-cycle [coll x]
   "Returns a lazy sequence of intermediate results, starting at x, of
@@ -59,26 +68,32 @@
     (curvature ds 0)))

 (defn traversal [ds indices seeds]
-  (let [stacks (map (fn [i] [i ()]) (take 2 indices))
-        queues (map (fn [i] [i []]) (drop 2 indices))
-        op (fn [i D] (if D (.op ds i D) nil))]
-    ((fn collect [seeds-left next seen]
-       (let [tmp (map (fn [[k d]] [k (drop-while #(seen [% k]) d)]) next)
-             r (first (filter (comp seq second) tmp))]
-         (if r
-           (let [[i [D & s]] r
-                 new-next (map (fn [[k x]]
-                                 [k (if (= k i) s (conj x (op k D)))])
-                               tmp)
-                 new-seen (into seen [[D] [D i] [(op i D) i]])]
+  (let [op (fn [i D] (if D (.op ds i D) nil))
+        stacks (map #(vector % ()) (take 2 indices))
+        queues (map #(vector % empty-queue) (drop 2 indices))
+        as-root #(vector % :root)
+        pop-seen (fn [xs seen]
+                   (for [[i ys] xs]
+                     (vector i (pop-while #(or (nil? %) (seen [% i])) ys))))
+        push-neighbors #(for [[i ys] %1] (vector i (conj ys (op i %2))))]
+    ((fn collect [seeds-left todo seen]
+       (let [seeds-left (drop-while (comp seen as-root) seeds-left)
+             todo (pop-seen todo seen)
+             [i todo-for-i] (first (filter (comp seq second) todo))]
+         (cond
+           (seq todo-for-i)
+           (let [D (first todo-for-i)
+                 todo (doall (push-neighbors todo D))
+                 seen (conj seen (as-root D) [D i] [(op i D) i])]
+             (lazy-seq (conj (collect seeds-left todo seen) [D i])))
+           (seq seeds-left)
+           (let [D (first seeds-left)
+                 todo (doall (push-neighbors todo D))
+                 seen (conj seen (as-root D))]
              (lazy-seq
-               (conj (collect seeds-left new-next new-seen) [D i])))
-           (if-let [D (first (filter (comp not seen) seeds-left))]
-             (let [new-next (map (fn [[k x]] [k (conj x (op k D))]) tmp)
-                   new-seen (conj seen D)]
-               (lazy-seq
-                 (conj (collect (rest seeds-left) new-next new-seen) [D])))
-             ()))))
+               (conj (collect (rest seeds-left) todo seen) (as-root D))))
+           :else
+           ())))
       (seq seeds) (doall (concat stacks queues)) #{})))

 ;; Azulenoid-specific functions


Some more Clojure code added.

Some more Clojure code added.

--- clojure/org/gavrog/clojure/azulenoids.clj
+++ clojure/org/gavrog/clojure/azulenoids.clj
@@ -2,6 +2,27 @@
   (:import (org.gavrog.jane.numbers Whole)
            (org.gavrog.joss.dsyms.basic DSymbol DynamicDSymbol)
            (org.gavrog.joss.dsyms.generators CombineTiles DefineBranching2d)))
+
+(defn walk [ds D & idxs]
+  (if (empty? idxs)
+    D
+    (recur ds (.op ds (first idxs) D) (rest idxs))))
+
+(defn max-curvature [ds]
+  (let [dsx (.clone ds)]
+    (do (.setVDefaultToOne dsx true) (.curvature2D dsx))))
+
+(defn syms-for [ds]
+  (if (.isNegative (max-curvature ds))
+    []
+    (new DefineBranching2d ds 3 2 Whole/ZERO)))
+
+(defn subdiv [ds pos]
+  )
+
+(defn subdivs-for [ds]
+  (map (partial subdiv ds) (range 1 16 2)))
+

 (def template
   (new DSymbol (str "1.1:60:"
@@ -18,19 +39,4 @@

 (def sets (new CombineTiles octagon))

-(defn max-curvature [ds]
-  (let [dsx (.clone ds)]
-    (do (.setVDefaultToOne dsx true) (.curvature2D dsx))))
-
-(defn syms-for [ds]
-  (if (.isNegative (max-curvature ds))
-    []
-    (new DefineBranching2d ds 3 2 Whole/ZERO)))
-
 (def syms (mapcat syms-for sets))
-
-(defn subdiv [ds pos]
-  )
-
-(defn subdivs-for [ds]
-  (map (partial subdiv ds) (range 1 16 2)))


Moved old test into t_canary

Moved old test into t_canary

--- test/behaviors/t_canary.clj
+++ test/behaviors/t_canary.clj
@@ -41,3 +41,11 @@
    (provided
      (all-procedures) => [...procedure...] ))

+(unfinished f)
+(against-background [ (f 1) => 2 ]
+  (after-silently
+   (fact "prerequisites can be used within checks"
+     (against-background (around :checks (let [x 1] ?form)))
+     (+ (f x) 2) => 4)
+   (fact (only-passes? 1) => truthy)))
+


No sense in delaying the delayable ;)

No sense in delaying the delayable ;)

--- web/src/immutant/web/undertow/http.clj
+++ web/src/immutant/web/undertow/http.clj
@@ -61,7 +61,7 @@
                :query-string (delay (.getQueryString exchange))
                :scheme (delay (-> exchange .getRequestScheme keyword))
                :request-method (delay (-> exchange .getRequestMethod .toString .toLowerCase keyword))
-               :content-type (delay @content-type)
+               :content-type content-type
                :content-length (delay (.getRequestContentLength exchange))
                :character-encoding (delay (if @content-type
                                             (Headers/extractTokenFromHeader @content-type "charset")))


Updated runSimulation function so that all eChild results are written to the output file at once after every instance of doesChildLearnGrammar has finished

--- src/research_clojure/runSimulation.clj
+++ src/research_clojure/runSimulation.clj
@@ -60,13 +60,13 @@
   [sentences max_eChildren max_sentences]
   (io/delete-file "out.csv" :silently true)

-  (let [results []]
-    (loop [i 0]
-      (when (< i max_eChildren)
-        (conj results (future (doesChildLearnGrammar sentences max_sentences)))
-        (recur (inc i))))
-    (writeResults results))
-  (println "Finished simulation"))
+  (loop [i 0
+         results []]
+    (if (< i max_eChildren)
+      (do
+        (recur (inc i) (conj results (future (doesChildLearnGrammar sentences max_sentences)))))
+      (do
+        (writeResults results) (println "Finished simulation")))))

 (comment


Deactivate dragStart for now

Deactivate dragStart for now

--- src/chessground/drag.cljs
+++ src/chessground/drag.cljs
@@ -33,7 +33,7 @@
   (q/wrapper component
              :onMount (fn [node]
                         (-> (new js/Draggabilly node)
-                            (.on "dragStart" on-start)
+                            ; (.on "dragStart" on-start)
                             (.on "dragStart" (push-args! (:drag-start channels)))
                             (.on "dragMove" on-move)
                             (.on "dragEnd" (push-args! (:drag-end channels)))))))


fix onDragStart

fix onDragStart

--- src/chessground/drag.cljs
+++ src/chessground/drag.cljs
@@ -55,7 +55,7 @@
                (-> (new js/Draggabilly node)
                    (.on "dragStart" (fn [_ _ pointer] (center-piece pointer)))
                    (.on "dragStart" #(push! (:move-start channels) key))
-                   (.on "dragStart" (highlight-square (jq/parent ($ (get-target pointer)))))
+                   (.on "dragStart" (fn [_ _ pointer] (highlight-square (jq/parent ($ (get-target pointer))))))
                    (.on "dragMove" on-move)
                    (.on "dragEnd" undo-damages)
                    (.on "dragEnd" (fn [& args]


Add and extend documentation.

Add and extend documentation.

--- src/cli4clj/cli_tests.clj
+++ src/cli4clj/cli_tests.clj
@@ -40,7 +40,9 @@
              (exec-tested-fn tested-fn)))))

 (defn test-cli-stdout
-  "Takes a function to be tested and a vector of string input commands and returns the string that was printed to stdout as a result of executing the supplied commands in the cli provided by the tested-fn."
+  "Takes a function to be tested and a vector of string input commands and returns the string that was printed to stdout as a result of executing the supplied commands in the cli provided by the tested-fn.
+
+   If an optional string-latch is supplied, the call will block until the string-latch completed."
   ([tested-fn in-cmds]
     (.trim (with-out-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (exec-tested-fn tested-fn)))))
   ([tested-fn in-cmds sl]
@@ -62,7 +64,9 @@
              (exec-tested-fn tested-fn)))))

 (defn test-cli-stderr
-  "Takes a function to be tested and a vector of string input commands and returns the string that was printed to stderr as a result of executing the supplied commands in the cli provided by the tested-fn."
+  "Takes a function to be tested and a vector of string input commands and returns the string that was printed to stderr as a result of executing the supplied commands in the cli provided by the tested-fn.
+
+   If an optional string-latch is supplied, the call will block until the string-latch completed."
   ([tested-fn in-cmds]
     (.trim (utils/with-err-str (with-in-str (cmd-vector-to-test-input-string in-cmds) (exec-tested-fn tested-fn)))))
   ([tested-fn in-cmds sl]
@@ -86,6 +90,16 @@
       (rest expected-lines))))

 (defn string-latch
+  "A string-latch can be used for testing CLI UI interaction with multi-threaded behaviour.
+
+   The latch takes a vector of string-latch definitions (sl-defs).
+   Each string-latch definition defines a \"wait\" point, which will block the execution of the main CLI UI test thread until the string-latch definition was matched in the CLI output.
+   When multiple string-latch definitions are configured in the vector, the definitions have to be matched in the CLI output in the order in which they are defined in the sl-defs vector.
+
+   A string-latch definition can either be a string or a two element vector of a string and a function.
+   When only a string is used, the latch will simply await the occurrence of the string in the CLI output.
+   When the two element vector is used, the latch will wait for the occurrence of the string and will call the function once the string was matched.
+   Both representations, string and string plus function vector, can be mixed in the overall string-latch definitions vector."
   [sl-defs]
   (let [flags (doall
                 (mapv


Adjust to refactoring of cli.clj.

Adjust to refactoring of cli.clj.

--- src/cli4clj/cli_tests.clj
+++ src/cli4clj/cli_tests.clj
@@ -24,8 +24,8 @@

 (defn create-repl-read-test-fn
   "This function creates a repl read function for testing."
-  [cmds prompt-string]
-  (create-repl-read-fn cmds))
+  [opts]
+  (create-repl-read-fn opts))

 (defn exec-tested-fn
   "This function takes another function as argument and executes it in a way that is suited for testing."


CLJS-377: allow any sequential value for :only and :refer `ns` options

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -614,7 +614,7 @@
         (reduce (fn [s [k exclude xs]]
                   (if (= k :refer-clojure)
                     (do
-                      (assert (= exclude :exclude) "Only [:refer-clojure :exclude [names]] form supported")
+                      (assert (= exclude :exclude) "Only [:refer-clojure :exclude (names)] form supported")
                       (assert (not (seq s)) "Only one :refer-clojure form is allowed per namespace definition")
                       (into s xs))
                     s))
@@ -629,7 +629,7 @@
                                (assert (symbol? (first spec))
                                        (error-msg spec "Library name must be specified as a symbol in :require / :require-macros"))
                                (assert (odd? (count spec))
-                                       (error-msg spec "Only :as alias and :refer [names] options supported in :require"))
+                                       (error-msg spec "Only :as alias and :refer (names) options supported in :require"))
                                (assert (every? #{:as :refer} (map first (partition 2 (next spec))))
                                        (error-msg spec "Only :as and :refer options supported in :require / :require-macros"))
                                (assert (let [fs (frequencies (next spec))]
@@ -643,15 +643,15 @@
                                      [rk uk] (if macros? [:require-macros :use-macros] [:require :use])]
                                  (assert (or (symbol? alias) (nil? alias))
                                          (error-msg spec ":as must be followed by a symbol in :require / :require-macros"))
-                                 (assert (or (and (vector? referred) (every? symbol? referred))
+                                 (assert (or (and (sequential? referred) (every? symbol? referred))
                                              (nil? referred))
-                                         (error-msg spec ":refer must be followed by a vector of symbols in :require / :require-macros"))
+                                         (error-msg spec ":refer must be followed by a sequence of symbols in :require / :require-macros"))
                                  (swap! deps conj lib)
                                  (merge (when alias {rk {alias lib}})
                                         (when referred {uk (apply hash-map (interleave referred (repeat lib)))})))))
         use->require (fn use->require [[lib kw referred :as spec]]
-                       (assert (and (symbol? lib) (= :only kw) (vector? referred) (every? symbol? referred))
-                               (error-msg spec "Only [lib.ns :only [names]] specs supported in :use / :use-macros"))
+                       (assert (and (symbol? lib) (= :only kw) (sequential? referred) (every? symbol? referred))
+                               (error-msg spec "Only [lib.ns :only (names)] specs supported in :use / :use-macros"))
                        [lib :refer referred])
         parse-import-spec (fn parse-import-spec [spec]
                             (assert (and (symbol? spec) (nil? (namespace spec)))


throw on (var foo) if foo does not exist

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -311,18 +311,29 @@
 (defn implicit-import? [env prefix suffix]
   (contains? '#{goog goog.object goog.string goog.array Math} prefix))

-(defn confirm-var-exists [env prefix suffix]
-  (let [sufstr (str suffix)
-        suffix (symbol
-                 (if (re-find #"\." sufstr)
-                   (first (string/split sufstr #"\."))
-                   suffix))]
-    (when (and (not (implicit-import? env prefix suffix))
-               (not (and (not (get-in @env/*compiler* [::namespaces prefix]))
-                         (or (get (:requires (:ns env)) prefix)
-                             (get (:imports (:ns env)) prefix))))
-               (not (get-in @env/*compiler* [::namespaces prefix :defs suffix])))
-      (warning :undeclared-var env {:prefix prefix :suffix suffix}))))
+(defn confirm-var-exists
+  ([env prefix suffix]
+    (confirm-var-exists env prefix suffix
+      (fn [env prefix suffix]
+        (warning :undeclared-var env {:prefix prefix :suffix suffix}))))
+  ([env prefix suffix missing-fn]
+    (let [sufstr (str suffix)
+          suffix (symbol
+                   (if (re-find #"\." sufstr)
+                     (first (string/split sufstr #"\."))
+                     suffix))]
+      (when (and (not (implicit-import? env prefix suffix))
+              (not (and (not (get-in @env/*compiler* [::namespaces prefix]))
+                     (or (get (:requires (:ns env)) prefix)
+                       (get (:imports (:ns env)) prefix))))
+              (not (get-in @env/*compiler* [::namespaces prefix :defs suffix])))
+        (missing-fn env prefix suffix)))))
+
+(defn confirm-var-exists-throw []
+  (fn [env prefix suffix]
+    (confirm-var-exists env prefix suffix
+      (fn [env prefix suffix]
+        (throw (error env (str "Unable to resolve var: " suffix " in this context")))))))

 (defn resolve-ns-alias [env name]
   (let [sym (symbol name)]
@@ -534,7 +545,7 @@

 (defmethod parse 'var
   [op env [_ sym :as form] _ _]
-  (let [var (resolve-var env sym)]
+  (let [var (resolve-var env sym (confirm-var-exists-throw))]
     {:env env :op :var-special :form form
      :var (analyze env sym)
      :sym (analyze env `(quote ~(symbol (name (:ns var)) (name (:name var)))))


CLJS-447: Allow each ns alias to be used up to twice

Each alias can now be used up to twice, once for a fn namespace and
once for a macro namespace. This allows the following (which had
worked before 7be3051):

(ns foo.user
  (:require [foo.core :as f])
  (:require-macros [foo.core :as f]))

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -603,7 +603,7 @@
                     s))
                 #{} args)
         deps (atom #{})
-        aliases (atom #{})
+        aliases (atom {:fns #{} :macros #{}})
         valid-forms (atom #{:use :use-macros :require :require-macros :import})
         error-msg (fn [spec msg] (str msg "; offending spec: " (pr-str spec)))
         parse-require-spec (fn parse-require-spec [macros? spec]
@@ -626,9 +626,13 @@
                                      {alias :as referred :refer :or {alias lib}} (apply hash-map opts)
                                      [rk uk] (if macros? [:require-macros :use-macros] [:require :use])]
                                  (when alias
-                                   (assert (not (contains? @aliases alias))
-                                           (error-msg spec ":as alias must be unique"))
-                                   (swap! aliases conj alias))
+                                   (let [alias-type (if macros? :macros :fns)]
+                                     (assert (not (contains? (alias-type @aliases)
+                                                             alias))
+                                             (error-msg spec ":as alias must be unique"))
+                                     (swap! aliases
+                                            update-in [alias-type]
+                                            conj alias)))
                                  (assert (or (symbol? alias) (nil? alias))
                                          (error-msg spec ":as must be followed by a symbol in :require / :require-macros"))
                                  (assert (or (and (sequential? referred) (every? symbol? referred))


no more goog.global namespace by default

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -86,8 +86,9 @@

 (defn js-var [sym]
   (let [parts (string/split (name sym) #"\.")
+        first (first parts)
         step (fn [part] (str "['" part "']"))]
-    (apply str "goog.global" (map step parts))))
+    (apply str first (map step (rest parts)))))

 (defn resolve-existing-var [env sym]
   (if (= (namespace sym) "js")


fix a bug in encoding sam tags

fix a bug in encoding sam tags

--- src/cljam/bam/encoder.clj
+++ src/cljam/bam/encoder.clj
@@ -127,14 +127,11 @@
            \c nil
            \C nil
            \s nil
-           \S (let [bb (lsb/gen-byte-buffer)
-                    total-len (+ 1 4 (* 2 (count array)))]
-                ;; (lsb/write-bytes writer (byte-array 1 (byte \S)))
-                (.put bb (byte-array 1 (byte \S)) 1)
-                ;; (lsb/write-int writer (count array))
+           \S (let [total-len (+ 1 4 (* 2 (count array)))
+                    bb (lsb/gen-byte-buffer total-len)]
+                (.put bb (byte-array 1 (byte \S)) 0 1)
                 (.putInt bb (count array))
                 (doseq [v array]
-                  ;; (lsb/write-short writer (Short/parseShort v))
                   (.putShort bb (Short/parseShort v)))
                 (Arrays/copyOfRange (.array bb) 0 total-len))
            \i nil


Need to add client side navigation

Need to add client side navigation

--- src/cljs/metime/core.cljs
+++ src/cljs/metime/core.cljs
@@ -16,28 +16,34 @@

 (def app-state
-  (atom {:state []}))
+  (atom {}))
+
+(defn refresh-navigation []
+;;   (
+;;    ;;let [token (.getToken history)
+;;    let [token "/employee/1"
+;;         set-active (fn [nav]
+;;                      (assoc-in [:state :active] (= (:path nav) token)))]
+
+;;    ;; #(map set-active %)
+;;    (swap! app-state #(map set-active %))
+;;    (println (str "token: " token))
+;;    (app-state))
+;;   (let [token "/employee/1"
+;;         set-active (fn [nav] (assoc nav :active (= (:path nav) token)))])
+;;   (swap! app-state #(map set-active %))
+)
+
+(refresh-navigation)

 (def history (History.))

-(defn refresh-navigation []
-   (
-     let [token (.getToken history)
-          set-active (fn [nav]
-                       (assoc-in nav [:state] :active (= (:path nav) token)))]
-
-    ;; #(map set-active %)
-    (swap! app-state #(map set-active %))
-    (println (str "token: " token))))
-
-
 (defn on-navigate [event]
-  (refresh-navigation)
-  (secretary/dispatch! (.-token event)))
+  (refresh-navigation)
+  (secretary/dispatch! (.-token event)))

 (defroute "/employees/:id" [id]
   (println (str "employee id: " id )))
-

 (defn fetch-departments
   [url]
@@ -54,7 +60,7 @@

 (defcomponent gravatar [email-address owner {:keys [size] :as opts}]
   (display-name [_]
-    "gravatar")
+                "gravatar")

   (render [_]
           (html
@@ -63,35 +69,35 @@

 (defcomponent employee-info [{:keys [lastname firstname email id]}]
   (display-name [_]
-    "employee-info")
+                "employee-info")

   (render [_]
-    (let [edit (fn [e]
-                 (secretary/dispatch! (str "/employees/" id))
-                 (println "You clicked the button"))]
-   (html
-     [:div {:class "col-sm-3 col-lg-3"}
-       [:div {:class "dash-unit"}
-         [:div {:class "thumbnail" :style {:margin-top "20px"}}
-          [:a {:href (str "/#/employees/" id)}
-           [:h1 (employee-name firstname lastname)]
-           [:div {:style {:margin-top "20px"}} (->gravatar email {:opts {:size 100}})]
-          ]
-          [:div {:class "info-user"}
-            [:span {:aria-hidden "true" :class "li_user fs1"}]
-            [:span {:aria-hidden "true" :class "li_calendar fs1"}]
-            [:span {:aria-hidden "true" :class "li_mail fs1"}]
-            [:span {:aria-hidden "true" :class "glyphicon glyphicon-trash fs1"}]
-          ]
+          (let [edit (fn [e]
+                       (secretary/dispatch! (str "/employees/" id))
+                       (println "You clicked the button"))]
+            (html
+             [:div {:class "col-sm-3 col-lg-3"}
+              [:div {:class "dash-unit"}
+               [:div {:class "thumbnail" :style {:margin-top "20px"}}
+                [:a {:href (str "/#/employees/" id)}
+                 [:h1 (employee-name firstname lastname)]
+                 [:div {:style {:margin-top "20px"}} (->gravatar email {:opts {:size 100}})]
+                 ]
+                [:div {:class "info-user"}
+                 [:span {:aria-hidden "true" :class "li_user fs1"}]
+                 [:span {:aria-hidden "true" :class "li_calendar fs1"}]
+                 [:span {:aria-hidden "true" :class "li_mail fs1"}]
+                 [:span {:aria-hidden "true" :class "glyphicon glyphicon-trash fs1"}]
+                 ]

-          ;; For now, just simulate the number of days remaining
-          [:h2 {:class "text-center" :style {:color "red"}} (rand-int 25)]
-         ]]]))))
+                ;; For now, just simulate the number of days remaining
+                [:h2 {:class "text-center" :style {:color "red"}} (rand-int 25)]
+                ]]]))))

 (defcomponent department-employees [{:keys [department managerid manager-firstname manager-lastname manager-email employees]} owner opts]
   (display-name [_]
-    "department-name")
+                "department-name")

   (render [_]
           (let [department-employees (filter #(not= (:id %) managerid) employees)
@@ -104,44 +110,44 @@
                 [:div.col-md-4.col-xs-4 (om/build gravatar manager-email {:opts {:size 50}})]
                 [:div.col-md-8.col-xs-8
                  [:h5 (str manager-firstname " " manager-lastname)]
+                 ]
                 ]
-               ]
                [:div.col-md-10.col-xs-10
                 [:div.col-md-11.col-xs-11
                  [:h2 department]
-                ]
+                 ]
                 [:div.col-md-1.col-xs-1
                  [:button {:class "btn btn-default glyphicon glyphicon-sort"
                            :data-toggle "collapse"
                            :data-parent "accordian"
                            :data-target (str "#" (clojure.string/replace department #"[\s]" "-"))}]
+                 ]
                 ]
                ]
-              ]

               [:div.panel-body.panel-collapse.collapse {:id (clojure.string/replace department #"[\s]" "-") :style {:height "auto"}}
-                 (if (not (zero? (count rows-of-employees)))
-                   (for [employee-row rows-of-employees]
-                     [:div.row.accordian-inner
-                      (for [employee-info-component (om/build-all employee-info employee-row)]
-                        employee-info-component)])
+               (if (not (zero? (count rows-of-employees)))
+                 (for [employee-row rows-of-employees]
                    [:div.row.accordian-inner
-                    [:h5.text-center "Currently, this department does not contain any employees"]])]]))))
+                    (for [employee-info-component (om/build-all employee-info employee-row)]
+                      employee-info-component)])
+                 [:div.row.accordian-inner
+                  [:h5.text-center "Currently, this department does not contain any employees"]])]]))))

 (defcomponent department-list [{:keys [departments]}]
   (display-name [_]
-    "department-list")
+                "department-list")

   (render [_]
-   (html
-    [:div.clearfix.accordian
-       (dom/ul (om/build-all department-employees departments))])))
+          (html
+           [:div.clearfix.accordian
+            (dom/ul (om/build-all department-employees departments))])))

 (defcomponent departments-container [app owner opts]
   (display-name [_]
-    "departments-box")
+                "departments-box")

   (will-mount [_]
               (go
@@ -154,7 +160,6 @@
                  [:div.row
                   (->department-list app)])))

-
 (defcomponent om-app [app owner]
   (display-name [_]
                 "app")
@@ -162,9 +167,8 @@
           (html
            [:div
             (->departments-container app
-                      {:opts {:url "http://localhost:3030/api/departments"
-                              :poll-interval 2000}})])))
-
+                                     {:opts {:url "http://localhost:3030/api/departments"
+                                             :poll-interval 2000}})])))
 (defn main []
   (doto history
     (goog.events/listen EventType/NAVIGATE on-navigate)


chapter 4 clojure core complete

chapter 4 clojure core complete

--- src/clojure_noon/core.clj
+++ src/clojure_noon/core.clj
@@ -696,3 +696,119 @@
 (into #{} (map identity [:garlic-clove :garlic-clove])) ; #{:garlic-clove} only one :garlic-clove since it is a set - into #{}

 ;;all the above examples have been with the first value as empty into into but it doesn't have to be
+(into {:favorite-emotion "gloomy"} [[:sunlight-reaction "Glitter!"]]) ; {:favorite-emotion "gloomy" :sunlight-reaction "Glitter!"}
+(into ["cherry"] '("pine" "spruce")) ;["cherry" "pine" "spruce"]
+
+;;and while the above shows two different empty-types converting into the first data-type, they can be both the same data-type
+(into {:favorite-animal "kitty"} {:least-favorite-smell "dog" :relationship-with-teenager "creepy"}) ;both arguments passed in are maps
+
+;;takes two collections and adding all the elements from the second into the first
+
+;;conj
+;;conj also adds elements to a collection but does it in a slightly different way
+(conj [0] [1]); [0 [1]]  -not what you expected huh?
+(into [0] [1]); [0 1] - compare into with conj to better elucidate the differences
+
+;;if you wanted the same behavior of into but using conj as above then
+(conj [0] 1) ;; [0 1]  ;;with into both arguments must be collections whereas with conj only the first argument must behavior
+
+(conj [0] 1 2 3 4) ;;[0 1 2 3 4] can accept a tonne of arguments
+
+;;conj and into are so similar that you can even define conj in terms of into
+(defn my-conj
+  [target & additions]
+  (into target additions))
+
+(my-conj [0] 1 2 3) ; [0 1 2 3] behaves just like conj but created using into
+
+;;Function Functions
+;; learning to accept functions as arguments and return functions as values takes some getting used tonne
+;; two such functions are apply and partial
+
+;;apply explodes a seqable data structure so it can be passed to a function that expects a rest parameter
+(max 0 2 4 5 3) ; 5 - takes a number of arguments and returns the greatest of all arguments
+(max [0 1 2]) ; [0 1 2] - here you are passing in a single argument of a vector, you want to pass in the contents of the vector as arguments
+
+;;apply is perfect for this usage
+(apply max [0 1 2]) ; returns 2
+
+;; apply is often used like this, exploding the elements of a collection so that they get passed to a function as separate arguments
+;; you can define into in terms of conj by using apply
+(defn my-into
+  [target additions]
+  (apply conj target additions)) ;;apply explodes whatever is passed into additions so they are passed in as exploded arguments
+
+(my-into [0] [1 2 3])  ;; equivalent of calling (conj [0] 1 2 3)
+
+;;partial
+;;partial takes a function and a number of arguments - then returns a new function - when you call the returned function, it calls the original function with the original arguments you supplied along with the new arguments
+
+(def add10 (partial + 10))
+(add10 3) ; 13 - when you call add10 it calls the original function and arguments +10 and tacks on whatever arguments you call add10 with such as 3 in this case and 5 in the case below
+(add10 5) ; 15
+
+(def add-missing-elements
+  (partial conj ["water" "earth" "air"]))
+
+(add-missing-elements "unobtanium" "adamantium") ;["water" "earth" "air" "unobtanium" "adamantium"]
+
+;;writing your own partial
+(defn my-partial
+  [partialized-fn & args]
+  (fn [& more-args]
+    (apply partialized-fn (into args more-args))))
+
+(def add20 (my-partial + 20))
+(add20 3) ;23
+
+;;the anonymous function returned by add20 is defined as below
+(fn [& more-args]
+  (apply + (into [20] more-args)))
+
+;;here's a toy example of how you could use partial to specialize a logger creating a warn function
+(defn lousy-logger
+  [log-level message]
+  (condp = log-level
+    :warn (clojure.string/lower-case message)
+    :emergency (clojure.string/upper-case message)))
+
+(def warn (partial lousy-logger :warn))
+
+(warn "Red light ahead") ; "red light ahead" ;;calling (warn "Red light ahead") is identical to calling (lousy-logger :warn "Red light ahead")
+
+;;complement
+(defn identify-humans
+  [social-security-numbers]
+  (filter #(not (vampire? %))
+          (map vampire-related-details social-security-numbers))) ;; #(not (vampire? %)) is so common that there's a function for it called complement
+
+(defn not-vampire? (complement vampire?))
+(defn identify-humans
+  [social-security-numbers]
+  (filter not-vampire?
+          (map vampire-related-details social-security-numbers)))
+
+;;your own complement
+(defn my-complement
+  [fun]
+  (fn [& args]
+    (not (apply fun args))))
+
+(def my-pos (complement neg?))
+(my-pos 1) ;;true
+(my-pos -1) ;;false
+
+;;complement does one little thing well.
+
+
+
+
+
+
+
+
+
+
+
+
+


Add STDOUT.putc

Add STDOUT.putc

--- src/clojure_ruby/core.clj
+++ src/clojure_ruby/core.clj
@@ -99,6 +99,13 @@

 (swap! variables assoc "File" File)

+(def STDOUT
+  {:methods {"putc" (fn STDOUT-putc [this char-int]
+                      (let [char-int (host-send char-int :number)]
+                        (print (char char-int))))}})
+
+(swap! variables assoc "STDOUT" STDOUT)
+
 (declare evaluate)
 (defmulti evaluate-one first)