Fix indentation.

Fix indentation.

--- src/cli4clj/cli.clj
+++ src/cli4clj/cli.clj
@@ -199,7 +199,7 @@
 				(get-in cmds [cmd :fn])
 				(rest arg)))
           (and allow-eval (list? arg)) (eval arg)
-           :default (err-fn (str "Invalid command: \"" arg "\". Please type \"help\" to get an overview of commands.") opts))
+          :default (err-fn (str "Invalid command: \"" arg "\". Please type \"help\" to get an overview of commands.") opts))
         (catch Exception e
           (err-fn e opts))))))


The new mkpol is here.

The new mkpol is here.

--- src/clj3D/fenvs.clj
+++ src/clj3D/fenvs.clj
@@ -587,9 +587,9 @@
 	size (count points)
         vertices (float-array (flatten points))
         tex-cord (float-array (flatten (repeat size [0 0 1])))
-        indexes (int-array
-		 (flatten
-		  (map vector (repeat size 0) (range 1 (dec size)) (range 2 size))))
+	idx-triples (flatten
+		     (map vector (repeat size 0) (range 1 (dec size)) (range 2 size)))
+        indexes (int-array (+ idx-triples (reverse idx-triples)))
         normals (float-array (flatten (repeat (count points) [0 0 1])))]

     (doto ^Mesh stripe-mesh
@@ -650,12 +650,7 @@
      (.setMaterial (unlit-material)))

    [:2 dim]
-   (let [start (first vertices)
-	 vertices (next vertices)
-	 size (count vertices)]
-     (doto (struct2 (map (fn [[x y z]] (triangle x y z))
-			 (map vector
-			      (repeat size start) (butlast vertices) (next vertices))))
-       (.setMaterial (default-material))))
+   (doto (apply trianglestripe vertices)
+     (.setMaterial (default-material)))

    [? dim] (throw (IllegalArgumentException. (str "mkpol: " dim " is not a valid dimension.")))))


A user with name "none" is actually no user.

--- src-cljs/frontend/models/build.cljs
+++ src-cljs/frontend/models/build.cljs
@@ -40,9 +40,12 @@

 (defn ui-user [build]
   (let [user (:user build)]
-    (if (not-empty (:name user))
-       (:name user)
-       (:login user))))
+    (cond
+      (not-empty (:name user)) (:name user)
+      ;; Currently, if there's no user associated with a build, we get a "user",
+      ;; but its login is "none". Until we have a better representation,
+      ;; recognize that as a sentinel value.
+      (not= "none" (:login user)) (:login user))))

 (defn status-icon [build]
   (cond (= "success" (:outcome build)) "fa-check"


Remove unused NS

Remove unused NS

--- planck-cljs/src/planck/stacktrace.cljs
+++ planck-cljs/src/planck/stacktrace.cljs
@@ -1,55 +0,0 @@
-(ns planck.stacktrace
-  (:require [clojure.string :as string]))
-
-(defn source-uri->relative-path
-  "Takes a source URI and returns a relative path value suitable for inclusion
-  in a canonical stack frame."
-  [source-uri]
-  {:pre [(string? source-uri)]}
-  (let [c (count "file:///")]
-    (if (and (> (count source-uri) c)
-          (= "file:///" (subs source-uri 0 c)))
-      (subs source-uri c)
-      (str "<" source-uri ">"))))
-
-(defn stack-line->canonical-frame
-  "Parses a stack line into a frame representation, returning nil
-  if parse failed."
-  [stack-line]
-  {:pre  [(string? stack-line)]}
-  (let [[function source-uri line column]
-        (rest (re-matches #"(.*)@(.*):([0-9]+):([0-9]+)"
-                stack-line))]
-    (if (and source-uri function line column)
-      {:file     (source-uri->relative-path source-uri)
-       :function function
-       :line     (js/parseInt line)
-       :column   (js/parseInt column)}
-      (let [[source-uri line column]
-            (rest (re-matches #"(.*):([0-9]+):([0-9]+)"
-                    stack-line))]
-        (if (and source-uri line column)
-          {:file     (source-uri->relative-path source-uri)
-           :function nil
-           :line     (js/parseInt line)
-           :column   (js/parseInt column)}
-          (when-not (string/blank? stack-line)
-            {:file     nil
-             :function (string/trim stack-line)
-             :line     nil
-             :column   nil}))))))
-
-(defn raw-stacktrace->canonical-stacktrace
-  "Parse a raw JSC stack representation, parsing it into stack frames.
-  The canonical stacktrace must be a vector of maps of the form
-  {:file <string> :function <string> :line <integer> :column <integer>}."
-  [raw-stacktrace opts]
-  {:pre  [(string? raw-stacktrace) (map? opts)]
-   :post [(vector? %)]}
-  (let [stack-line->canonical-frame (memoize stack-line->canonical-frame)]
-    (->> raw-stacktrace
-      string/split-lines
-      (map stack-line->canonical-frame)
-      (remove nil?)
-      vec)))
-


add bad markup field clear capability

add bad markup field clear capability

--- src/crison/core.clj
+++ src/crison/core.clj
@@ -68,9 +68,12 @@
 (defn compute-fill [{:keys [fill-submit!] :as x}]
   (let [head (butlast fill-submit!)]
     (doseq [e head]
-      (let [txt-val (:text! e)
-            field (dissoc e :text!)]
-        (-> driver (wc/find-element field) (wc/input-text txt-val))))))
+      (if (:clear! e)
+        (let [field (dissoc e :clear!)]
+          (-> driver (wc/find-element field) (wc/clear)))
+        (let [txt-val (:text! e)
+              field (dissoc e :text!)]
+          (-> driver (wc/find-element field) (wc/input-text txt-val)))))))

 (defmethod decode :fill-submit! [{:keys [fill-submit! pause] :as x}]
   (if (seq (filter #(:text! %) (butlast fill-submit!)))


pager image showing properly

pager image showing properly

--- examples/lesson-carousel-starter-kit/src/carousel/core.cljs
+++ examples/lesson-carousel-starter-kit/src/carousel/core.cljs
@@ -12,7 +12,7 @@
 (defonce PhysicsEngine (.. famous -physics -PhysicsEngine))
 (defonce physics (.. famous -physics))
 (defonce math (.. famous -math))
-(defonce Box (.. physics -Box))
+(defonce FamousBox (.. physics -Box))
 (defonce Spring (.. physics -Spring))
 (defonce RotationalSpring (.. physics -RotationalSpring))
 (defonce RotationalDrag (.. physics -RotationalDrag))
@@ -29,13 +29,9 @@
       (setProperty "lineHeight" "40px")
       (setProperty "cursor" "pointer")
       (setProperty "textHighlight" "none")
-      (setProperty "zIndex" "2")
-      (setProperty "backgroundImage" "url('http://demo.famo.us.s3.amazonaws.com/hub/apps/carousel/Museo_del_Prado_-_Goya_-_Caprichos_-_No._01_-_Autorretrato._Francisco_Goya_y_Lucientes2C_pintor_thumb.jpg')")
-      )
+      (setProperty "zIndex" "2"))
   (.. (GestureHandler. arrow-node) (on "tap" (fn []
-                                               (println text))))
-
-  )
+                                               (println text)))))

 (defn decorate-dots [dots-node]
   (let [dot-nodes (.. dots-node getChildren)
@@ -100,11 +96,11 @@
                                     image-url (str "url('" _image-url "')")
                                     image-node (.. root-node addChild)
                                     el (DOMElement. image-node)
-                                    box (Box. {:mass 100 :size [100 100 100]})
+                                    box (FamousBox. {:mass 100 :size [100 100 100]})
                                     anchor (Vec3. 1 0 0)
                                     spring (Spring. nil box {:period 0.5 :dampingRatio 0.5 :anchor anchor})
                                     quaternion (.. (Quaternion.) (fromEuler 0  (/ (.. js/Math -PI) -2) 0))
-                                    rotational-spring (RotationalSpring nil  box {:period 1 :dampingRatio 0.2 :anchor quaternion})]
+                                    rotational-spring (RotationalSpring. nil  box {:period 1 :dampingRatio 0.2 :anchor quaternion})]
                                 (.. image-node
                                     (setSizeMode ABSOLUTE ABSOLUTE ABSOLUTE)
                                     (setAbsoluteSize 500 500 0)
@@ -117,7 +113,7 @@
                                     (setProperty "background-size" "cover"))
                                 ))
                             image-names)
-
+        _ (doall image-elements)
         pager {:node pager-node
                :onUpdate (fn [time]
                            (.. simulation (update time))
@@ -146,13 +142,13 @@
                       :dots dots}]
     (.. back-node
         (setSizeMode 1 1)
-        (setAbsoluteSize 240 240)
+        (setAbsoluteSize 40 40)
         (setPosition 40 0 0)
         (setAlign 0 0.5 0)
         (setMountPoint 0 0.5 0))
     (.. next-node
         (setSizeMode 1 1)
-        (setAbsoluteSize 240 240)
+        (setAbsoluteSize 40 40)
         (setPosition -40 0 0)
         (setAlign 1 0.5 0)
         (setMountPoint 1 0.5 0))


warn on cljs version differences

warn on cljs version differences

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -7,15 +7,32 @@
     [boot.pod                    :as pod]
     [boot.core                   :as core]
     [boot.file                   :as file]
-    [boot.util                   :refer [info dbug]]
+    [boot.util                   :refer [info dbug warn]]
     [adzerk.boot-cljs.util       :as util]
     [adzerk.boot-cljs.middleware :as wrap]
     [adzerk.boot-cljs.js-deps    :as deps]))

+(def +version+ "0.0-2814")
+
 (def ^:private deps
   "ClojureScript dependency to load in the pod if
    none is provided via project"
-  (delay (remove pod/dependency-loaded? '[[org.clojure/clojurescript "0.0-2814"]])))
+  (delay (remove pod/dependency-loaded? '[[org.clojure/clojurescript "0.0.0"]])))
+
+(defn warn-on-cljs-version-differences []
+  (let [proj-deps  (core/get-env :dependencies)
+        proj-dep?  (set (map first proj-deps))
+        all-deps   (map :dep (pod/resolve-dependencies (core/get-env)))
+        trans-deps (remove #(-> % first proj-dep?) all-deps)
+        cljs?      #{'org.clojure/clojurescript}
+        find-cljs  (fn [ds] (first (filter #(-> % first cljs?) ds)))
+        trans-cljs (find-cljs trans-deps)
+        proj-cljs  (find-cljs proj-deps)]
+    (cond
+      (and proj-cljs (neg? (compare (second proj-cljs) +version+)))
+      (warn "WARNING: CLJS version older than boot-cljs: %s\n" (second proj-cljs))
+      (and trans-cljs (not= (second trans-cljs) +version+))
+      (warn "WARNING: Different CLJS version via transitive dependency: %s\n" (second trans-cljs)))))

 (defn- set-output-dir-opts
   [{:keys [output-dir] :as opts} tmp-out]
@@ -123,6 +140,8 @@
         tmp-out    (core/temp-dir!)
         tmp-result (core/temp-dir!)
         ctx        (initial-context tmp-out tmp-src tmp-result *opts*)]
+
+    (warn-on-cljs-version-differences)
     (comp
       (default-main :context ctx)
       (core/with-pre-wrap fileset


showing future-facts again

showing future-facts again

--- .midje.clj
+++ .midje.clj
@@ -1,3 +1,3 @@
 (change-defaults :fact-filter #(and (not (:slow %1))
                                     (not (:acceptance %1)))
-                 :visible-future false)+                 )


remove additional check recently added having to do with deferred model construction

--- src/babel/directory.cljc
+++ src/babel/directory.cljc
@@ -18,8 +18,7 @@
         la (promise)
         it (promise)]
     {:en (fn []
-           (if (and (realized? en)
-                    (map? en))
+           (if (realized? en)
              en
              (deliver en
                       (do (log/debug (str "starting to load english model.."))


specify created language model for english to improve performance

--- src/babel/directory.cljc
+++ src/babel/directory.cljc
@@ -10,9 +10,11 @@
    [dag_unify.core :refer [get-in]]))

 (def models
-  {"en" (conj (babel.english.grammar/small)
-              {:generate-fn (fn [spec]
-                              (en/generate spec))})
+  {"en"
+   (let [model (babel.english.grammar/small)]
+     (conj model
+           {:generate-fn (fn [spec]
+                           (en/generate spec :model model))}))
    "la" babel.latin/model})


Start wiring up a join table

Start wiring up a join table

--- src/doctopus/db.clj
+++ src/doctopus/db.clj
@@ -56,7 +56,17 @@
   (prepare add-date-fields)
   (prepare ->snake-keys)
   (transform ->kebab-keys)
-  (has-many tentacles {:fk :head_name}))
+  (has-many head-tentacle-mappings {:fk :head_name})
+  ;; (has-many tentacles {:fk :head_name})
+  )
+
+(defentity head-tentacle-mappings
+  (fk :head-name)
+  (fk :tentacle-name)
+  (prepare ->snake-keys)
+  (transform ->kebab-keys)
+  (has-one heads {:fk :name})
+  (has-one tentacles {:fk :name}))

 (defn get-tentacle
   [name]
@@ -67,6 +77,11 @@
 (defn get-all-tentacles
   []
   (select tentacles))
+
+(defn get-tentacles-for-head
+  [head]
+  (select tentacles
+          (where {:head-name (:name head)})))

 (defn save-tentacle!
   [tentacle]


add -source-url to ISourceMap protocol. add source-url field to JavaScriptFile. propagate :source-file to :source-rul field in map->javascript-file. use source-url when emitting source map

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -237,6 +237,7 @@
   (-source [this] "The JavaScript source string."))

 (defprotocol ISourceMap
+  (-source-url [this] "Return the CLJS source url")
   (-source-map [this] "Return the CLJS compiler generated JS source mapping"))

 (extend-protocol IJavaScript
@@ -258,7 +259,7 @@
                     s
                     (slurp (io/reader (-url this))))))

-(defrecord JavaScriptFile [foreign ^URL url provides requires lines source-map]
+(defrecord JavaScriptFile [foreign ^URL url ^URL source-url provides requires lines source-map]
   IJavaScript
   (-foreign? [this] foreign)
   (-url [this] url)
@@ -266,18 +267,20 @@
   (-requires [this] requires)
   (-source [this] (slurp (io/reader url)))
   ISourceMap
+  (-source-url [this] source-url)
   (-source-map [this] source-map))

 (defn javascript-file
   ([foreign ^URL url provides requires]
-     (javascript-file foreign url provides requires nil nil))
-  ([foreign ^URL url provides requires lines source-map]
-     (JavaScriptFile. foreign url (map name provides) (map name requires) lines source-map)))
+     (javascript-file foreign url nil provides requires nil nil))
+  ([foreign ^URL url source-url provides requires lines source-map]
+     (JavaScriptFile. foreign url source-url (map name provides) (map name requires) lines source-map)))

 (defn map->javascript-file [m]
   (javascript-file
     (:foreign m)
     (to-url (:file m))
+    (to-url (:source-file m))
     (:provides m)
     (:requires m)
     (:lines m)
@@ -717,10 +720,13 @@
                     (+ line-offset (or (:lines source) 0))
                     (let [path (.getPath ^URL (:url source))]
                       (if-let [compiled (get @compiled-cljs path)]
-                        (assoc result path
+                        (assoc result (:source-url source)
                           (sm/merge-source-maps (:source-map compiled) closure-source-map line-offset))
-                        result))))
-                (spit (io/file (str name ".merged")) (sm/encode result {}))))))
+                        (assoc result path source)))))
+                (let [out-name (str name ".merged")]
+                  (spit (io/file out-name)
+                    (sm/encode result
+                      {:lines line-offset :file out-name})))))))
         source)
       (report-failure result))))


support binary field

support binary field

--- src/clj/dbquery/core.clj
+++ src/clj/dbquery/core.clj
@@ -32,6 +32,7 @@
     (let [sdf (SimpleDateFormat. fmt)]
       (.writeString jsonGenerator (.format sdf d)))))

+(add-encoder (Class/forName "[B") #(.writeString %2 "<binary>"))
 (add-encoder java.util.Date (date-time-encoder "dd/MM/yyyy"))
 (add-encoder java.sql.Date (date-time-encoder "dd/MM/yyyy"))
 (add-encoder java.sql.Timestamp (date-time-encoder "dd/MM/yyyy HH:mm:ss"))


fix code error

fix code error

--- src/cljs/ceres/core.cljs
+++ src/cljs/ceres/core.cljs
@@ -59,8 +59,7 @@

 (defn y
   "Compute linear y component"
-  [data heigh
-   t]
+  [data height]
   (-> d3
       .-scale
       (.linear)


Use compiler option to skip certain logs in release

--- src/clojure/neko/log.clj
+++ src/clojure/neko/log.clj
@@ -24,42 +24,45 @@
   {:author "Adam Clements"}
   (:import android.util.Log))

-(defn- logger [logfn args]
-  (let [[strings kwargs] (split-with (complement #{:exception :tag}) args)
-        {:keys [exception tag]} (if (odd? (count kwargs))
-                                  (butlast kwargs)
-                                  kwargs)
-        tag (or tag (str *ns*))]
-    (if exception
-      `(. Log ~logfn ~tag (apply str (interpose " " [~@strings])) ~exception)
-      `(. Log ~logfn ~tag (apply str (interpose " " [~@strings]))))))
+(defn- logger [logfn priority-kw args]
+  (when-not ((set (:neko.init/ignore-log-priority *compiler-options*))
+             priority-kw)
+    (println priority-kw)
+    (let [[strings kwargs] (split-with (complement #{:exception :tag}) args)
+          {:keys [exception tag]} (if (odd? (count kwargs))
+                                    (butlast kwargs)
+                                    kwargs)
+          tag (or tag (str *ns*))]
+      (if exception
+        `(. Log ~logfn ~tag (apply str (interpose " " [~@strings])) ~exception)
+        `(. Log ~logfn ~tag (apply str (interpose " " [~@strings])))))))

 (defmacro e
   "Log an ERROR message, applying pr-str to all the arguments and taking
    an optional keyword :exception or :tag at the end which will print the
    exception stacktrace or override the TAG respectively"
-  [& args] (logger 'e args))
+  [& args] (logger 'e :error args))

 (defmacro d
   "Log a DEBUG message, applying pr-str to all the arguments and taking
    an optional keyword :exception or :tag at the end which will print the
    exception stacktrace or override the TAG respectively"
-  [& args] (logger 'd args))
+  [& args] (logger 'd :debug args))

 (defmacro i
   "Log an INFO message, applying pr-str to all the arguments and taking
    an optional keyword :exception or :tag at the end which will print the
    exception stacktrace or override the TAG respectively"
-  [& args] (logger 'i args))
+  [& args] (logger 'i :info args))

 (defmacro v
   "Log a VERBOSE message, applying pr-str to all the arguments and taking
    an optional keyword :exception or :tag at the end which will print the
    exception stacktrace or override the TAG respectively"
-  [& args] (logger 'v args))
+  [& args] (logger 'v :verbose args))

 (defmacro w
   "Log a WARN message, applying pr-str to all the arguments and taking
    an optional keyword :exception or :tag at the end which will print the
    exception stacktrace or override the TAG respectively"
-  [& args] (logger 'w args))
+  [& args] (logger 'w :warn args))


Extract coll->dom

Extract coll->dom

--- src/ankha/core.cljs
+++ src/ankha/core.cljs
@@ -3,8 +3,7 @@
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [clojure.string :as string]
-            [goog.object :as object]
-            [brepl.connect]))
+            [goog.object :as object]))

 (enable-console-print!)

@@ -88,6 +87,23 @@
                    :key (str pair)}
         (inspect* x)))))

+(defn- coll->dom [data]
+  (cond
+   (map? data)
+   (associative->dom data {:entry-class "map-entry"
+                           :key-class "map-key"
+                           :val-class "map-val"})
+   (object? data)
+   (let [;; Avoid zipmap to preserve key order.
+         ks (object/getKeys data)
+         vs (object/getValues data)
+         m (map vector ks vs)]
+     (associative->dom m {:entry-class "object-entry"
+                          :key-class "object-key"
+                          :val-class "object-val"}))
+   :else
+   (sequential->dom data)))
+
 (defn- toggle-button [owner {:keys [disable?]}]
   (dom/button #js {:className "toggle-button"
                    :disabled disable?
@@ -129,21 +145,7 @@
                      :style #js {:display (if open? "block" "none")
                                  :listStyleType "none"
                                  :margin "0"}}
-          (cond
-            (map? data)
-            (associative->dom data {:entry-class "map-entry"
-                                    :key-class "map-key"
-                                    :val-class "map-val"})
-            (object? data)
-            (let [;; Avoid zipmap to preserve key order.
-                  ks (object/getKeys data)
-                  vs (object/getValues data)
-                  m (map vector ks vs)]
-              (associative->dom m {:entry-class "object-entry"
-                                   :key-class "object-key"
-                                   :val-class "object-val"}))
-            :else
-            (sequential->dom data)))
+          (coll->dom data))

         (dom/span #js {:className "ellipsis"
                        :style #js {:display (if (or open? vacant?)


expand book object

expand book object

--- src/clj/reader_web_app/entities.clj
+++ src/clj/reader_web_app/entities.clj
@@ -7,7 +7,7 @@
 (defentity books
   (pk :id)
   (table :books)
-  (entity-fields :title :id))
+  (entity-fields :title :id :firstname :lastname :genre))

 (defentity users
   (pk :id)


update route

update route

--- src/clj/salava/metabadge/routes.clj
+++ src/clj/salava/metabadge/routes.clj
@@ -22,15 +22,15 @@
                   :summary "get all metabadges"
                   :auth-rules access/signed
                   :current-user current-user
-                  ;(cron/every-hour ctx)
+                  (cron/every-hour ctx)
                   ;(salava.metabadge.db/get-metabadges-in-progress ctx (:id current-user))
                   (ok (mb/all-metabadges ctx current-user)))

-             (GET "/info" [assertion_url]
-                  :return schemas/Metabadge
+             (GET "/info" [user_badge_id]
+                  ;:return schemas/Metabadge
                   :summary "get metabadge info via assertion url"
                   :current-user current-user
-                  (ok (mb/check-metabadge ctx assertion_url)))
+                  (ok (db/get-metabadge ctx user_badge_id (:id current-user)) #_(mb/check-metabadge ctx assertion_url)))

              (GET "/badge/info" [user_badge_id]
                   ;:return schemas/Milestone?


Implemented step 9, trivial in this case

--- src/cljs/reagent_phonecat/core.cljs
+++ src/cljs/reagent_phonecat/core.cljs
@@ -114,6 +114,8 @@
                            [[:dt t] (for [d ds][:dd d])]
                            )))]])

+(defn checkmark [input] (if input \u2713 \u2718))
+
 (defn phone-detail-cpnt [phone]
   (let [{:keys [images name description availability additionalFeatures]
          {:keys [ram flash]} :storage
@@ -138,11 +140,11 @@
       [phone-spec-cpnt "Availability and Networks" [(cons "Availability" availability)]]
       [phone-spec-cpnt "Battery" [["Type" type] ["Talk Time" talkTime] ["Standby time (max)" standbyTime]]]
       [phone-spec-cpnt "Storage and Memory" [["RAM" ram] ["Internal Storage" flash]]]
-      [phone-spec-cpnt "Connectivity" [["Network Support" cell] ["WiFi" wifi] ["Bluetooth" bluetooth] ["Infrared" (str  infrared)] ["GPS" (str gps)]]]
+      [phone-spec-cpnt "Connectivity" [["Network Support" cell] ["WiFi" wifi] ["Bluetooth" bluetooth] ["Infrared" (checkmark infrared)] ["GPS" (checkmark gps)]]]
       [phone-spec-cpnt "Android" [["OS Version" os] ["UI" ui]]]
       [phone-spec-cpnt "Size and Weight" [(cons "Dimensions" dimensions) ["Weight" weight]]]
-      [phone-spec-cpnt "Display" [["Screen size" screenSize] ["Screen resolution" screenResolution] ["Touch screen" (str touchScreen)]]]
-      [phone-spec-cpnt "Hardware" [["CPU" cpu] ["USB" usb] ["Audio / headphone jack" audioJack] ["FM Radio" (str fmRadio)] ["Accelerometer" (str  accelerometer)]]]
+      [phone-spec-cpnt "Display" [["Screen size" screenSize] ["Screen resolution" screenResolution] ["Touch screen" (checkmark touchScreen)]]]
+      [phone-spec-cpnt "Hardware" [["CPU" cpu] ["USB" usb] ["Audio / headphone jack" audioJack] ["FM Radio" (checkmark fmRadio)] ["Accelerometer" (checkmark accelerometer)]]]
       [phone-spec-cpnt "Camera" [["Primary" primary] ["Features" (str/join ", " features)]]]
       [:li
        [:span "Additional Features"]


Fix Banner log in bug

Fix Banner log in bug

--- src/cljs/salava/core/ui/layout.cljs
+++ src/cljs/salava/core/ui/layout.cljs
@@ -62,8 +62,8 @@
 [:a {:class "logo pull-left"
      :title (session/get :site-name)
      :aria-label "to index"
-     :href  (if (session/get :user) (path-for (if (social-plugin?) "/social" "/badge")) "#")
-     :on-click #(if (not (session/get :user)) (set! (.-location.href js/window) (session/get :site-url))  "")}
+     :href  (if (session/get-in [:user :first_name]) (path-for (if (social-plugin?) "/social" "/badge")) "#")
+     :on-click #(if (not (session/get-in [:user :first_name])) (set! (.-location.href js/window) (session/get :site-url))  "")}
     [:div {:class "logo-image logo-image-url hidden-xs hidden-sm hidden-md"
           :title "OBP logo"
           :aria-label "OBP logo"}]
@@ -116,8 +116,8 @@
    [:div {:class "container-fluid"}
     [:div {:class "navbar-header"}
      [:a {:class "logo pull-left"
-          :href  (if (session/get :user) (path-for (if (social-plugin?) "/social" "/badge")) "#")
-          :on-click #(if (not (session/get :user)) (set! (.-location.href js/window) (session/get :site-url)) "")
+          :href  (if  (session/get-in [:user :first_name]) (path-for (if (social-plugin?) "/social" "/badge")) "#")
+          :on-click #(if (not (session/get-in [:user :first_name])) (set! (.-location.href js/window) (session/get :site-url)) "")
           :title (session/get :site-name)}
       [:div {:class "logo-image logo-image-url hidden-xs hidden-sm hidden-md"}]
       [:div {:class "logo-image logo-image-icon-url visible-xs visible-sm  visible-md"}]]]]])


Fix paredit commands for the Macbook Air keyboard

--- src/clojure/paredit_widget/core.clj
+++ src/clojure/paredit_widget/core.clj
@@ -82,6 +82,11 @@
    [nil "⌦"] :paredit-forward-delete
    ["C" "Open Bracket"] :paredit-backward-barf-sexp
    ["C" "Close Bracket"] :paredit-forward-barf-sexp
+   ["M" "·"] :paredit-wrap-round
+   ["M" "ß"] :paredit-splice-sexp
+   ["M" "®"] :paredit-raise-sexp
+   ["M" "Í"] :paredit-split-sexp
+   ["M" "Ô"] :paredit-join-sexps
    ["M" "←"] :paredit-expand-left
    ["M" "→"] :paredit-expand-right
    ["M" "↑"] :paredit-expand-up})


Fix command retried metric

Fix command retried metric

This was trying to destructure an unparsed message, which obviously
fails.

--- src/com/puppetlabs/cmdb/command.clj
+++ src/com/puppetlabs/cmdb/command.clj
@@ -288,8 +288,9 @@
 (defn handle-command-retry
   "Dump the error encountered to the log, and re-publish the message
   with an incremented retry counter"
-  [{:keys [command version retries] :or {retries 0} :as msg} e publish-fn]
-  (mark! (get-in @*metrics* [command version :retried]))
+  [msg e publish-fn]
+  (let [{:keys [command version]} (parse-command msg)]
+    (mark! (get-in @*metrics* [command version :retried])))
   (log/error "Retrying message due to:" e)
   (publish-fn (format-for-retry msg)))


make it easier to call set_ab_test and app_state_to_js from the console

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -303,10 +303,14 @@
                                                 get-ab-tests
                                                 test-key))))

+(aset js/window "set_ab_test" set-ab-test)
+
 (defn ^:export app-state-to-js
   "Used for inspecting app state in the console."
   []
   (clj->js @debug-state))
+
+(aset js/window "app_state_to_js" set-ab-test)

 (defn ^:export reinstall-om! []


Added some comments.

Added some comments.

--- src-cljs/tea_time/core.cljs
+++ src-cljs/tea_time/core.cljs
@@ -10,6 +10,7 @@
   (:require-macros [reagent.ratom :refer [reaction]])
   (:import goog.History))

+;; -- Re-Frame handlers/subcriptions AKA Update

 (re-frame/register-handler
   :process-teas-response
@@ -116,6 +117,8 @@
 (defn value-event
   [event]
   (-> event .-target .-value))
+
+;; -- VIEW portion, with some view logic as well

 (defn nav-link [uri title page collapsed?]
   [:li {:class (when (= page (session/get :page)) "active")}
@@ -234,6 +237,7 @@
      [tea-adder]]
     [:div.col-xs-6]]])

+;; -- Routes, etc.

 (def pages
   {:home #'home-page


Exctract ring.util.servlet/set-status.

Exctract ring.util.servlet/set-status.

--- ring-servlet/src/ring/util/servlet.clj
+++ ring-servlet/src/ring/util/servlet.clj
@@ -52,7 +52,10 @@
      :servlet-response response
      :servlet-context  (.getServletContext servlet)}))

-(defn- set-headers
+(defn set-status [^HttpServletResponse response, status]
+  (.setStatus response status))
+
+(defn set-headers
   "Update a HttpServletResponse with a map of headers."
   [^HttpServletResponse response, headers]
   (doseq [[key val-or-vals] headers]
@@ -97,7 +100,7 @@
   (when-not response
     (throw (Exception. "Null response given.")))
   (when status
-    (.setStatus response status))
+    (set-status response status))
   (doto response
     (set-headers headers)
     (set-body body)))


Got inverse + forward kinematics + collision checking working

--- ros/angelic_planning/src/ros/robot.clj
+++ ros/angelic_planning/src/ros/robot.clj
@@ -541,7 +541,7 @@
 			:joints (map make-kinematic-joint joint-map)}))]
 ;     (println res)
      (assert (= (count (:link_names res)) (count (:link_poses res))))
-    (cons (:in_collision res)
+    (cons (> (:in_collision res) 0)
 	  (lazy-seq [(apply hash-map (interleave (:link_names res) (:link_poses res)))]))))

 (defn robot-forward-kinematics
@@ -554,20 +554,52 @@
       (map-msg (world->collision-map world)) 1)
     (robot-forward-kinematics nh robot)))

+(defn rand-double [[mn mx]]
+  (+ mn (rand (- mx mn))))
+
+(defn random-arm-joint-map [nh right?]
+  (when-not *robot-joint-limits* (get-robot-xml))
+;    (doseq [joint (keys (:joint-angle-map (get-current-arm-state nh right?)))
+;	  :let [limits (*robot-joint-limits* joint)]]
+;      (println joint limits))
+    (into {}
+    (for [joint (keys (:joint-angle-map (get-current-arm-state nh right?)))
+	  :let [limits (*robot-joint-limits* joint)]]
+      [joint (rand-double
+	      (or limits
+		 (do (println "Warning: no limits for joint" joint)
+		     [0 (* 2 Math/PI)])))])))
+
 (defn safe-inverse-kinematics
-  ([#^NodeHandle nh robot world tries]
-     (put-single-message "/fk_node/collision_map"
-       (map-msg (world->collision-map world)) 1)
-     (loop [tries tries]
-       (when (> tries 0)
+  "Find an IK solution respecting the collision space.  Pass
+   world if you want its collision map published.
+   Other initial joint configurations will be randomly generated."
+  [#^NodeHandle nh right? pose-stamped robot world random-retries]
+     (when world
+       (put-single-message "/fk_node/collision_map"
+	 (map-msg (world->collision-map world)) 1))
+     (let [all-joints (get-joint-map robot)]
+      (loop [tries random-retries
+	    init-joints (:joint-angle-map ((if right? :rarm :larm) robot))]
+;       (println init-joints)
+       (or (when-let [sol (inverse-kinematics nh right? pose-stamped init-joints)]
+	     (prn sol)
+	     (println)
+	     (print "Found IK solution ... ")
+	     (let [collision (first (forward-kinematics nh (merge all-joints sol)))]
+	       (println (if collision "" " not ") "in collision.")
+	       (when (not collision)
+		 sol)))
+	   (when (> tries 0)
+	     (println "IK failed; retrying with random initial joints.")
+	     (recur (dec tries) (random-arm-joint-map nh right?)))))))

 ; (inverse-kinematics nh true {:class PoseStamped :header *tll-header* :pose {:class Pose :position {:class Point :x 0.53 :y -0.02 :z -0.38} :orientation {:class Quaternion :x 0.0 :y 0.0 :z 0.0 :w 1.0}}} (:joint-angle-map (get-current-arm-state nh true)))

-;(defn rand-double [[mn mx]]
-;  (+ mn (rand (- mx mn))))
+
 ;
 ;  (def *rarm-joint-limits*
 ;       (into {}
@@ -583,9 +615,7 @@
 ;	    (if-let [p (get *robot-joint-limits* j)]
 ;	        (vec (map read-string p))
 ;	      [(- Math/PI) Math/PI])])))
-;(defn rand-joint-config [right?]
-;  (into {}
-;    (map (fn [[k v]] [k (rand-double v)]) (if right? *rarm-joint-limits* *larm-joint-limits*))))
+

 ;(defn move-arm-directly-to-pose [nh right? pose-stamped ]


Minor edits.

Minor edits.

--- src/bru_3/frame.clj
+++ src/bru_3/frame.clj
@@ -6,18 +6,18 @@
   (vertices [this] (vec (map (partial get this) [:tl :tr :bl :br])))
   (edges [this]
     (let [edge (fn [[v1 v2]] (vec (map (partial get this) [v1 v2])))
-          pairs [[:tl :tr] [:tr :bl] [:bl :br] [:br :tl]]]
+          pairs [[:tl :tr] [:tr :br] [:br :bl] [:bl :tl]]]
       (map edge pairs))))

 (defn from-bones
-  "Creates a frame in between the two given bones b1 and b2, using the randomization maximum rm to offset the bone
-  vertices. rm is given as a percentage in the [0, 1] range. When rm = 0, there'll be no vertex randomization, and the
+  "Creates a frame in between the two given bones b1 and b2, using the randomization maximum r to offset the bone
+  vertices. r is given as a percentage in the [0, 1] range. When r = 0, there'll be no vertex randomization, and the
   frame will fit exactly between the two bones. For any other value, a random percentage will be added or subtracted
   from the bone lengths, and the frame will be constructed using the resulting shortened/elongated bones."
-  [b1 b2 rp]
+  [b1 b2 r]
   (let [;; make a function for getting randomized length in [-rp, rp] range
         rand-range (fn [min max] (+ min (rand (- max min))))
-        rfn (fn [] (rand-range (- rp) rp))
+        rfn (fn [] (rand-range (- r) r))
         ;; randomize each bone length
         rb1 (update-in b1 [:length] * (rfn))
         rb2 (update-in b2 [:length] * (rfn))]


changed namespace from db to db-ram

changed namespace from db to db-ram

--- src/casper/core.clj
+++ src/casper/core.clj
@@ -5,7 +5,7 @@
   (:require
     [ casper.crypto :refer [encrypt decrypt encrypt-base64 decrypt-base64]]
     ;[ casper.db-ram :refer [insert-secret select-secret delete-secret]]
-    [ casper.db :refer [insert-secret select-secret delete-secret]]
+    [ casper.db-ram :refer [insert-secret select-secret delete-secret]]
     [charset-bytes.core :refer [utf8-bytes]]
     [compojure.handler :as handler]
     [compojure.route :as route]


add callback to ftask

add callback to ftask

(ftask f1 :callback {:on-response f2
                     :on-failure f3})

by default both `on-response` and `on-failure` are "identity"

--- src/chazel/core.clj
+++ src/chazel/core.clj
@@ -5,7 +5,7 @@
   (:import [java.util Collection Map]
            [java.io Serializable]
            [java.util.concurrent Callable]
-           [com.hazelcast.core Hazelcast IMap ICollection EntryEvent ITopic Message MessageListener]
+           [com.hazelcast.core Hazelcast IMap ICollection EntryEvent ITopic Message MessageListener ExecutionCallback]
            [com.hazelcast.topic ReliableMessageListener]
            [com.hazelcast.query SqlPredicate PagingPredicate]
            [com.hazelcast.client HazelcastClient]
@@ -441,13 +441,23 @@
   (call [_] (fun)))

 (defn- task-args [& {:keys [members instance es-name]
-                   :or {members :any
-                        instance (if (client-instance?)
-                                  (client-instance)
-                                  (hz-instance))
-                        es-name :default}
-                   :as args}]
+                     :or {members :any
+                          instance (if (client-instance?)
+                                     (client-instance)
+                                     (hz-instance))
+                          es-name :default}
+                     :as args}]
   (assoc args :exec-svc (.getExecutorService instance (name es-name))))
+
+(defn execution-callback [{:keys [on-response on-failure]
+                           :or {on-response identity
+                                on-failure identity}}]
+  (reify
+    ExecutionCallback
+    (onFailure [this throwable]
+      (on-failure throwable))
+    (onResponse [this response]
+      (on-response response))))

 (defn task [fun & args]
   (let [{:keys [exec-svc members]} (apply task-args args)]
@@ -456,10 +466,15 @@
       (.execute exec-svc (Task. fun)))))

 (defn ftask [fun & args]
-  (let [{:keys [exec-svc members]} (apply task-args args)]
+  (let [{:keys [exec-svc members callback]} (apply task-args args)]
     (if (= :all members)
-      (.submitToAllMembers exec-svc (Task. fun))
-      (.submit exec-svc (Task. fun)))))
+      (.submitToAllMembers exec-svc (Task. fun))    ;; TODO: add MultiExecutionCallback
+      (if callback
+        (.submit exec-svc
+                 (Task. fun)
+                 (execution-callback callback))
+        (.submit exec-svc
+                 (Task. fun))))))

 (defn mtake [n m]
   (into {} (take n (hz-map m))))


Cleaning up Incident a bit

Cleaning up Incident a bit

--- src/cia/threats.clj
+++ src/cia/threats.clj
@@ -87,6 +87,8 @@
   {:id ID ;; optional in spec
    :timestamp m/Time ;; timestamp "for this version"; optional in spec
    :description [s/Str] ;; optional in spec
+   :confidence m/Confidence ;; squashed
+
    (s/optional-key :short_description) [s/Str]
    (s/optional-key :status) m/Status
    (s/optional-key :version) s/Str
@@ -99,6 +101,12 @@
    (s/optional-key :affected_assets) m/AffectedAsset
    (s/optional-key :impact_assessment) m/ImpactAssessment
    (s/optional-key :source) m/Source ;; was information_source
+   (s/optional-key :security_compromise) m/SecurityCompromise
+   (s/optional-key :discovery_method) m/DiscoveryMethod
+   (s/optional-key :coa_requested) [m/Reference]
+   (s/optional-key :coa_taken) [m/Reference]
+   (s/optional-key :contact m/Source)
+   (s/optional-key :history) m/History

    ;; The seqs of elements below are squashed (they leave out
    ;; structured data such as confidence and source for each element).
@@ -108,17 +116,6 @@
    (s/optional-key :attributed__actors) [m/Reference] ;; was attributed_threat_actors
    (s/optional-key :related_incidents) [m/Reference]
    (s/optional-key :intended_effect) m/IntendedEffect
-
-   :security_compromise m/SecurityCompromise
-   :discover_method m/DiscoveryMethod
-
-   :coa_requested [m/Reference]
-   :coa_taken [m/Reference]
-
-   :confidence m/Confidence ;; squashed
-
-   (s/optional-key :contact m/Source)
-   (s/optional-key :history) m/History

    ;; Not provided: idref
    ;; Not provided: URL


minor - formatting

minor - formatting

--- src/client/dom.cljs
+++ src/client/dom.cljs
@@ -38,13 +38,13 @@

 (defn set-color-background! []
   (-> ($ "body")
-    (.removeClass "bg-grey-e2019")
-    (.addClass "bg-color-c025c")))
+      (.removeClass "bg-grey-e2019")
+      (.addClass "bg-color-c025c")))

 (defn set-bw-background! []
   (-> ($ "body")
-    (.removeClass "bg-color-c025c")
-    (.addClass "bg-grey-e2019")))
+      (.removeClass "bg-color-c025c")
+      (.addClass "bg-grey-e2019")))

 (def ^:private app-container-id (str (random-uuid)))
 (def ^:private panels-container-id (str (random-uuid)))


WIP: media queries, tmp rm dynamic queries

--- src/cljss/media.clj
+++ src/cljss/media.clj
@@ -173,9 +173,7 @@
 (defmethod compile-media-query :plain [[_ {:keys [feature-name feature-value]}]]
   (let [feature-name  (compile-media-query [:feature-name feature-name])
         feature-value (compile-media-query [:feature-value feature-value])]
-    (if (literal? feature-value)
-      (str "(" feature-name ":" feature-value ")")
-      `(cljs.core/str ~(str "(" feature-name ":") ~feature-value ")"))))
+    (str "(" feature-name ":" feature-value ")")))

 (defmethod compile-media-query :range [[_ range]]
   (compile-media-query range))
@@ -187,9 +185,7 @@
   (let [left     (compile-media-query left)
         right    (compile-media-query right)
         operator (name operator)]
-    (if (->> [left right] (map (comp not literal?) (filter identity) seq))
-      `(cljs.core/str "(" ~left " " ~operator " " ~right ")")
-      (str "(" left " " operator " " right ")"))))
+    (str "(" left " " operator " " right ")")))

 (defmethod compile-media-query :complex-range
   [[_ [_ {:keys [left left-operator feature-name right-operator right]}]]]
@@ -198,17 +194,16 @@
         right          (compile-media-query [:feature-value right])
         left-operator  (name left-operator)
         right-operator (name right-operator)]
-    (if (->> [left right] (map (comp not literal?) (filter identity) seq))
-      `(cljs.core/str "(" ~left ~(str " " left-operator " " feature-name " " right-operator " ") ~right ")")
-      (str "(" left " " left-operator " " feature-name " " right-operator " " right ")"))))
+    (str "(" left " " left-operator " " feature-name " " right-operator " " right ")")))

 (defn -compile-media-query [query]
   (let [ret (s/conform ::media-query query)
         ret (if (= ::s/invalid ret)
               (throw (Error. (s/explain ::media-query query)))
               (compile-media-query ret))]
-    `(cljs.core/str "@media " (clojure.string/join " " ~ret))))
-
+    (->> (flatten ret)
+         (clojure.string/join " ")
+         (str "@media "))))

 (defn compile-media-dispatch [styles]
   (cond
@@ -223,7 +218,7 @@
          (fn [[sstyles svalues] [query styles]]
            (let [[static values] (compile-media {:styles styles})
                  query (-compile-media-query query)]
-             [`(cljs.core/str ~sstyles ~query ~static) (concat svalues values)]))
+             [(str sstyles query static) (concat svalues values)]))
          ["" []])))

 (defmethod compile-media :styles [{styles :styles}]
@@ -244,8 +239,10 @@
 (defn build-media [styles]
   (compile-media {:media styles}))

-(c/reset-env! {:cls "class"})
-
-(build-media
-  {[:screen :and [:min-width 'a]] {:font-size 'p
-                                   :&:hover   {:color 'g}}})
+(comment
+  (c/reset-env! {:cls "class"})
+
+  (build-media
+    {[:only :screen :and [:min-width "300px"]]
+     {:font-size 'p
+      :&:hover   {:color 'g}}}))


Avoid warnings about unknown props in new React

--- examples/todomvc/src/todomvc/core.cljs
+++ examples/todomvc/src/todomvc/core.cljs
@@ -31,14 +31,15 @@
         save #(let [v (-> @val str clojure.string/trim)]
                 (if-not (empty? v) (on-save v))
                 (stop))]
-    (fn [props]
-      [:input (merge props
-                     {:type "text" :value @val :on-blur save
-                      :on-change #(reset! val (-> % .-target .-value))
-                      :on-key-down #(case (.-which %)
-                                      13 (save)
-                                      27 (stop)
-                                      nil)})])))
+    (fn [{:keys [id class placeholder]}]
+      [:input {:type "text" :value @val
+               :id id :class class :placeholder placeholder
+               :on-blur save
+               :on-change #(reset! val (-> % .-target .-value))
+               :on-key-down #(case (.-which %)
+                               13 (save)
+                               27 (stop)
+                               nil)}])))

 (def todo-edit (with-meta todo-input
                  {:component-did-mount #(.focus (r/dom-node %))}))


Microcosmetics

Microcosmetics

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

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -119,7 +119,8 @@
                        initial
                        (next-closed-set-in-family predicate base clop initial))]
          (take-while #(not (nil? %))
-                     (iterate (partial next-closed-set-in-family predicate base clop)
+                     (iterate (fn [X]
+                                (next-closed-set-in-family predicate base clop X))
                               start))))))

 (defn next-closed-set


Fix traits

Fix traits

--- src/edu/berkeley/ai/util/traits.clj
+++ src/edu/berkeley/ai/util/traits.clj
@@ -10,16 +10,37 @@
       (cons [proto methods]
             (parse-protocols-and-method-pairs more)))))

-(defn- parse-protocols-and-methods [args]
-  (let [pairs (parse-protocols-and-method-pairs args)]
-    (assert (apply distinct? (cons nil (map first pairs))))
-    (into {} pairs)))
+(defn rewrite-pm-pair [ns args [proto method]]
+;  (println ns args proto method)
+  (let [method-name    (first method)
+        method-args    (second method)
+        method-body    (next (next method))
+        all-args       (vec (concat method-args args))
+        fn-name        (gensym (str proto "-" method-name))
+        scoped-fn-name (symbol ns (name fn-name))]
+    (assert (apply distinct? (cons nil all-args)))
+    [(symbol ns (name proto))
+     `(~method-name ~method-args (~scoped-fn-name ~@all-args))
+     `(defn ~fn-name ~all-args ~@method-body)]))
+
+
+(defn- parse-protocols-and-methods [args specs]
+  (let [methods-by-proto (parse-protocols-and-method-pairs specs)
+        ns               (name (ns-name *ns*))
+        pm-pairs         (for [[p ms] methods-by-proto, m ms] [p m])
+;        _ (println pm-pairs)
+        pm-triples       (map #(rewrite-pm-pair ns args %) pm-pairs)]
+    (assert (apply distinct? (cons nil (map first methods-by-proto))))
+    [(map #(nth % 2) pm-triples)
+     (util/map-vals #(map second %) (group-by first pm-triples))]))

 (defn merge-traits [& traits]
   (let [bindings  (vec (apply concat (map first traits)))]
     (assert (apply distinct? (cons nil (take-nth 2 bindings))))
     [bindings
      (reduce util/merge-disjoint {} (map second traits))]))
+
+;; To allow traits to be used from other namespaces, easiest option is to emit named fns in defining ns ?

 (defn parse-trait-form [traits]
   (vec (map #(if (list? %)
@@ -29,11 +50,15 @@
 ;; Internal rep. of a trait is a fn from args to [binding-seq impl-map]
 ;; TODO: forn ow, args may be multiple evaluated?
 (defmacro deftrait [name args state-bindings child-traits & protocols-and-methods]
-  `(defn ~name ~args
-     (apply merge-traits
-      [(concat (interleave '~args ~args) '~state-bindings)
-       '~(parse-protocols-and-methods protocols-and-methods)]
-      ~(parse-trait-form child-traits))))
+  (let [[method-fn-defs protocol-method-bodies]
+        (parse-protocols-and-methods (concat args (take-nth 2 state-bindings)) protocols-and-methods)]
+;    (println method-fn-defs "\n" protocol-method-bodies)
+    `(do (defn ~name ~args
+           (apply merge-traits
+                  [(concat (interleave '~args ~args) '~state-bindings)
+                   '~protocol-method-bodies]
+                  ~(parse-trait-form child-traits)))
+         ~@method-fn-defs)))

 (defn- render-trait-methods-inline [trait-map]
   (apply concat (map (partial apply cons) trait-map)))
@@ -46,7 +71,7 @@
         ~@specs))))

-(comment
+(do #_comment

  (defprotocol P2
    (p21 [x y])
@@ -58,7 +83,8 @@

  (defprotocol P0)

- (deftrait +foo+ [x] [y (atom x)] [] P2 (p21 [x z] (+ z @y)) (p22 [x] (swap! y inc)) P0)
+ (deftrait +foo+ [x] [y (atom x)] [] P2 (p21 [foo z] (+ z @y)) (p22 [foo] (swap! y inc)) P0)

- (deftrait +bar+ [w] [z (inc w)] [(+foo+ (* w 2))] P1 (p11 [x y] (- y w))))
+                                        ; (deftrait +bar+ [w] [z (inc w)] [(+foo+ (* w 2))] P1 (p11 [bar y] (- y w)))
+ )


Refactor

Refactor

--- backend/src/akvo/lumen/endpoint/user.clj
+++ backend/src/akvo/lumen/endpoint/user.clj
@@ -16,30 +16,29 @@

 (defn routes [{:keys [keycloak] :as opts}]
   [["/user/admin" {:get {:handler (fn [{tenant :tenant
-                                               query-params :query-params}]
-                                           (lib/ok (select-keys (user/user keycloak tenant (get query-params "email"))
-                                                                [:email :admin])))}}]
-   ["/admin"
-     ["/users"
-      ["" {:get {:handler (fn [{tenant :tenant}]
-                            (user/users keycloak tenant))}}]
-      ["/:id" ["" {:patch {:parameters {:body map?
-                                        :path-params {:id string?}}
-                           :handler (fn [{tenant :tenant
-                                          jwt-claims :jwt-claims
-                                          {:keys [id]} :path-params
-                                          body :body}]
-                                      (cond
-                                        (demote-user? body)
-                                        (user/demote-user-from-admin keycloak tenant jwt-claims id)
-                                        (promote-user? body)
-                                        (user/promote-user-to-admin keycloak tenant jwt-claims id)
-                                        :else (http/not-implemented)))}
-                   :delete {:parameters {:path-params {:id string?}}
-                            :handler (fn [{tenant :tenant
-                                           jwt-claims :jwt-claims
-                                           {:keys [id]} :path-params}]
-                                       (user/remove-user keycloak tenant jwt-claims id))}}]]]]])
+                                        query-params :query-params}]
+                                    (lib/ok (select-keys (user/user keycloak tenant (get query-params "email"))
+                                                         [:email :admin])))}}]
+   ["/admin/users"
+    ["" {:get {:handler (fn [{tenant :tenant}]
+                          (user/users keycloak tenant))}}]
+    ["/:id" ["" {:patch {:parameters {:body map?
+                                      :path-params {:id string?}}
+                         :handler (fn [{tenant :tenant
+                                        jwt-claims :jwt-claims
+                                        {:keys [id]} :path-params
+                                        body :body}]
+                                    (cond
+                                      (demote-user? body)
+                                      (user/demote-user-from-admin keycloak tenant jwt-claims id)
+                                      (promote-user? body)
+                                      (user/promote-user-to-admin keycloak tenant jwt-claims id)
+                                      :else (http/not-implemented)))}
+                 :delete {:parameters {:path-params {:id string?}}
+                          :handler (fn [{tenant :tenant
+                                         jwt-claims :jwt-claims
+                                         {:keys [id]} :path-params}]
+                                     (user/remove-user keycloak tenant jwt-claims id))}}]]]])

 (defmethod ig/init-key :akvo.lumen.endpoint.user/user  [_ opts]
   (routes opts))


mild refactor

mild refactor

--- src/crawler/dom.clj
+++ src/crawler/dom.clj
@@ -402,10 +402,9 @@
      (xpaths-hrefs-tokens processed-body url (set [])))

   ([processed-body url blacklist]
-     (let [nodes-paths   (page-nodes-hrefs-text
-                          processed-body
-                          url
-                          blacklist)
+     (let [nodes-paths   (page-nodes-hrefs-text processed-body
+                                                url
+                                                blacklist)

            node-objs     (map
                           (fn [[path an-obj]]


Include mime type in query results

Include mime type in query results

--- src/doctopus/db.clj
+++ src/doctopus/db.clj
@@ -105,7 +105,7 @@
                      (dissoc :image))
                  (dissoc ent :image))))
   (belongs-to tentacles)
-  (entity-fields :name :uri :tentacle_name :body))
+  (entity-fields :name :uri :tentacle_name :body :mime_type))

 (defn get-tentacle
   [name]


glue everything together in core

glue everything together in core

--- src/duffel/core.clj
+++ src/duffel/core.clj
@@ -1,16 +1,12 @@
 (ns duffel.core
-    (:gen-class :main true)
-    (:use clojure.contrib.command-line)
-    (:require [duffel.fs      :as dfs]
-              [duffel.ext     :as dext]
-              [duffel.fs-util :as dfs-util]
-              duffel-ext.put
-              duffel-ext.git
-              duffel-ext.ignore
-              duffel-ext.touch
-              duffel-ext.dlns
-              duffel-ext.clerb
-              duffel-ext.pacman))
+  (:gen-class :main true)
+  (:use clojure.contrib.command-line)
+  (:require [duffel.ext.core     :refer [get-impl process-dir process-file]]
+            duffel.ext.load
+            [duffel.tree.core    :refer [dir->tree tree-map tree-get]]
+            [duffel.tree.paths   :refer [fill-paths]]
+            [duffel.tree.specify :refer [specify-tree]]
+            [duffel.tree.meta    :refer [collapse-meta cascade-meta]]))

 (defn doall*
     "Same as doall, but recursive"
@@ -22,54 +18,62 @@
     [s]
     (try (Integer/valueOf s) (catch Exception e nil)))

-(defn parse-chroot
-    "Make sure that chroot is properly formed"
-    [chroot]
-    (case chroot
-        ""  ""
-        "/" ""
-        (dutil/remove-trailing-slash chroot)))
+(defn process-el
+  "Given the app and either a duffel tree or a file-map, runs that items chosen
+  extension on it, returning the result"
+  [app el]
+  (if-let [ext-impl (get-impl (tree-get el :extension))]
+    (if (sequential? el)
+      (process-dir ext-impl app el)
+      (process-file ext-impl app el))
+    el))

-(defn run-on-dir
-    [dir app]
-    (try
-      (println "starting duffel run")
-      (doall*
-        (->> (dfs/specify-tree dir)
-          (dfs/translate-top-level)
-          (dfs/remove-special-dirs)
-          (dfs-util/chroot-tree (app :chroot))
-          (dfs-util/tree-map dfs/distribute-meta)
-          (dfs-util/tree-map dfs/filter-git)
-          (dext/pre-process)
-          (dext/process-templates)
-          (dext/post-template-process)
-          (dext/process app)
-          ))
-      (println "duffel run complete!")
-      nil
-    (catch Exception e (.printStackTrace e) (System/exit 1))))
+(defn process-exts
+  "Processes all extensions on a duffel tree"
+  [app dtree]
+  (tree-map
+    #(cons
+      (process-el app (first dtree))
+      (map (partial process-el app) (rest dtree)))
+    dtree))
+
+(defn run
+  "Runs the app itself, taking in the app map. It will create the duffel tree
+  for this project, process it, and handle all extensions"
+  [app]
+  (try
+    (println "starting duffel run")
+    (doall*
+      (->> (dir->tree (str (app :proj-root) "/root/"))
+           (fill-paths app)
+           (specify-tree app)
+           (collapse-meta)
+           (cascade-meta)
+           (process-exts app)))
+    (println "duffel run complete!")
+    nil
+  (catch Exception e (.printStackTrace e) (System/exit 1))))

 (def cli-help "A simple resource deployment tool. Check the docs at
 https://github.com/mediocregopher/duffel for more details\n\nUsage: duffel
 [OPTIONS] <duffel-directory>\n" )

-
 (defn -main [& args]
-    (with-command-line args
-        cli-help
-        [[ chroot "Directory to chroot to" "/" ]
-         [ no-backup? n? "Set if you don't want to do any backing up of files" ]
-         [ backup-directory b "Directory to backup files to" "/tmp/duffel_bak" ]
-         [ backup-count "Number of backup files to keep" "3" ]
-         remaining]
-         (if-let [dir (first remaining)]
-            (do
-              (run-on-dir dir { :chroot (parse-chroot chroot)
-                                :no-backup no-backup?
-                                :backup-dir backup-directory
-                                :backup-count (dutil/str->int backup-count) })
-              (System/exit 0))
-            (binding [*out* *err*]
-                (println "A duffel directory must be specified")
-                (System/exit 1)))))
+  (with-command-line args
+    cli-help
+    [[ chroot "Directory to chroot to" "/" ]
+     [ no-backup? n? "Set if you don't want to do any backing up of files" ]
+     [ backup-directory b "Directory to backup files to" "/tmp/duffel_bak" ]
+     [ backup-count "Number of backup files to keep" "3" ]
+     remaining]
+    (if-let [dir (first remaining)]
+      (do
+        (run { :proj-root (if-not (= (last dir) \/) (str dir "/") dir)
+               :chroot chroot
+               :no-backup no-backup?
+               :backup-dir backup-directory
+               :backup-count (str->int backup-count) }
+        (System/exit 0)))
+      (binding [*out* *err*]
+          (println "A duffel directory must be specified")
+          (System/exit 1)))))


update incoming route structure

update incoming route structure

--- src/gangway/web.clj
+++ src/gangway/web.clj
@@ -38,7 +38,7 @@

 (defn helmsman-definition
   [system]
-  [[:post "/in/:qid/:id-sk"  (:incoming! (liberator-resources system))]
+  [[:post "/in/:qid/:id-sk-origin/:entity-type/:id-sk"  (:incoming! (liberator-resources system))]
    [:get "/out" (:hi-there (liberator-resources system))]
    [wrap-params]
    [wrap-trace :header :ui]])


Fix indentation

Fix indentation

--- src/icecap/rest.clj
+++ src/icecap/rest.clj
@@ -62,7 +62,7 @@
                                        :store store :kdf kdf :scheme scheme)))
                     (DELETE "/" []
                             (<!! (delete-cap (safebase64-decode encoded-cap)
-                                                    :store store))))))
+                                             :store store))))))

 (defn ^:private wrap-components
   "Adds some components to each request map."


Refactor random move

Refactor random move

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -98,7 +98,7 @@

 (defn reset-random
   [state]
-  (merge state {:random false}))
+  (merge state {:random true}))

 (def interval 20)

@@ -117,19 +117,24 @@
        rand-nth
        first))

+
+(defn move-randomly
+  [world-state]
+  (swap! ticker dec)
+  (if (neg? @ticker)
+    (do
+      (reset! ticker interval)
+      (-> world-state
+          get-random-legal-move-name
+          (flip-update-edge world-state)))
+    world-state))
+
+
 (defn random-move
   [_ world-state]
   (if (:random world-state)
-    (do
-      (swap! ticker dec)
-      (if (neg? @ticker)
-        (do
-          (reset! ticker interval)
-          (let [random-move-name (get-random-legal-move-name world-state)]
-            (flip-update-edge random-move-name world-state)))
-        world-state))
+    (move-randomly world-state)
     world-state))
-

 (go


Delete parsing old state.

Delete parsing old state.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -46,26 +46,10 @@
       (.-id)))

-(defn nameless->named-map [the-name coll]
-  (let [ids (map (partial str the-name) (range))]
-    (into {} (map vector ids coll))))
-
-(def name-edges
-  (partial nameless->named-map edge-id))
-
-(def name-vertices
-  (partial nameless->named-map vert-id))
-
-(defn name-vertices-in-one-edge [[start end color]]
-  [(str-vert-id start)
-   (str-vert-id end)
-   color])

 (defn fmap [f m]
   (into {} (for [[k v] m] [k (f v)])))

-(defn name-vertices-in-all-edges [edges]
-  (fmap name-vertices-in-one-edge edges))

 (defn ok-to-flip? [{:keys [vertices edges]} [_ to color]]
   (let [edge-value (color->value color)
@@ -80,6 +64,7 @@
    (locations end)
    color
    (ok-to-flip? world-state edge)])
+

@@ -156,14 +141,6 @@
       (handle-playing clicked-what world-state))))

-(defn parse-state [state]
-  (let [named-edges (update-in state [:edges]
-                               (comp name-vertices-in-all-edges name-edges))
-        named-vertices (update-in named-edges [:vertices] name-vertices)
-        added-edit (merge named-vertices {:editing? false
-                                          :selected nil})]
-    added-edit))
-
 (defn reset-edit [state]
   (merge state {:editing? false
                 :selected nil}))


Correct rds resource types (#183)

Correct rds resource types (#183)

Db DBCluster name was copy and pasted.

Thanks @AgentO3 !

--- src/crucible/aws/rds.clj
+++ src/crucible/aws/rds.clj
@@ -8,10 +8,10 @@
 (defn rds [resource] (str "AWS::RDS::" (->key resource)))

 (defmethod ->key :db-cluster [_] "DBCluster")
-(defmethod ->key :db-instance [_] "DBCluster")
-(defmethod ->key :db-security-group [_] "DBCluster")
-(defmethod ->key :db-security-group-ingress [_] "DBCluster")
-(defmethod ->key :db-subnet-group [_] "DBCluster")
+(defmethod ->key :db-instance [_] "DBInstance")
+(defmethod ->key :db-security-group [_] "DBSecurityGroup")
+(defmethod ->key :db-security-group-ingress [_] "DBSecurityGroupIngress")
+(defmethod ->key :db-subnet-group [_] "DBSubnetGroup")

 (s/def ::db-instance (s/keys :opt [::dbi/allocated-storage
                                    ::dbi/allow-major-version-upgrade


implemented row/column operations; fixed subtle bugs; improved overall performance

--- src/engine/data/rope.clj
+++ src/engine/data/rope.clj
@@ -1,17 +1,13 @@
 (ns engine.data.rope
   "Implementation of Ropes as per \"Ropes: an Alternative to Strings\"
 by Boehm, Hans-J; Atkinson, Russ; and Plass, Michael (December 1995), doi:10.1002/spe.4380251203."
-  (:use [clojure.core :exclude [concat subs]]
-        [clojure.string :only [join]])
-  (:require [clojure.zip :as zip]
-            [clojure.core :as core])
+  (:use [clojure.string :only [join]])
+  (:require [clojure.zip :as zip])
   (:import [clojure.lang Counted Indexed]
            [java.lang String IndexOutOfBoundsException]))

-(doseq [fun ['concat 'subs]] (ns-unmap *ns* fun))
-
 (def *fib-seq* (map first (iterate (fn [[a b]] [b (+ a b)]) [0 1])))
-(def *leaf-cutoff-length* 128) ; TODO make constant in clojure 1.3
+(def *leaf-cutoff-length* 64) ; This value has been determined optimal for split operations through benchmarking. TODO make constant in clojure 1.3

 (defprotocol Measurable
   "Trivial protocol for things measurable.
@@ -24,12 +20,20 @@
   [x]
   (satisfies? Measurable x))

+(defn measure+
+  "Add up weights of measurements"
+  [& xs]
+  (->> xs (map vals) (reduce #(map + %1 %2)) (apply measurement)))
+
 (defrecord CharSequenceMeasurement [#^int length #^int lines])

+(defmethod print-method CharSequenceMeasurement [weight writer]
+  (print-simple (format "#<CharSequenceMeasurement %d/%d>" (:length weight) (:lines weight)) writer))
+
 (defn measurement
-  "CharSequenceMeasurement from length and lines"
-  [length lines]
-  (CharSequenceMeasurement. length lines))
+  "CharSequenceMeasurement from length and lines; (measurement) is 0/0"
+  ([] (CharSequenceMeasurement. 0 0))
+  ([length lines] (CharSequenceMeasurement. length lines)))

 (defn count-matches
   "Number of character matches in string"
@@ -64,7 +68,7 @@
   [x]
   (satisfies? Treeish-2-3 x))

-(defmulti concat
+(defmulti cat
   "Concatenation of two Ropes, including Strings which are treated as leafes"
   (fn [rope1 rope2] [(type rope1) (type rope2)]))

@@ -80,7 +84,7 @@
 (extend-type String
   Treeish-2-3
   (split [_ _] nil)
-  (conc [this coll] (concat this coll))
+  (conc [this coll] (cat this coll))
   (left [_] nil)
   (right [_] nil)
   (depth [_] 0))
@@ -104,7 +108,7 @@
   [seq]
   {:pre [(measurable? seq)]}
   (if (and (treeish-2-3? seq) (right seq)) ; no child on the right? not required to weigh again
-    (->> seq (iterate right) (take-while identity) (map measure) (map vals) (reduce #(map + %1 %2)) (apply measurement))
+    (->> seq (iterate right) (take-while identity) (map measure) (apply measure+))
     (measure seq)))

 (defn rope
@@ -161,55 +165,64 @@
              (recur (cons current acc) rest (fib-border length))))
           (fold acc))))))

-(defmethod concat :default [coll1 coll2]
+(defmethod cat :default [coll1 coll2]
   (let [new-rope (rope coll1 coll2)]
     (if (balanced? new-rope)
       new-rope
       (rebalance new-rope))))

-(defn string->rope
+(defn string->rope [string]
   "Create a fresh Rope from flat string.
 The resulting leafes will carry at most *leaf-cutoff-length* characters of the
 input string."
-  [string]
-  (->> (partition-all *leaf-cutoff-length* string) (map #(apply str %)) (reduce rope) rebalance rope))
-
-(defmethod concat [String String] [string1 string2]
+  (letfn [(build [acc]
+            (if (> (count acc) 1)
+              (recur (->> (partition-all 2 acc) (map #(apply rope %))))
+              (first acc)))]
+    (->> (partition-all (-> (count string) (/ (.. Runtime getRuntime availableProcessors)) int) string)
+         (pmap (bound-fn [chunk]
+                 (->> (partition-all *leaf-cutoff-length* chunk) (map #(apply str %)) build)))
+         build rope)))
+
+(defmethod cat [String String] [string1 string2]
   (let [string (str string1 string2)]
     (if (> (count string) *leaf-cutoff-length*)
      (string->rope string)
      string)))

 (defn rope-split
-  "Split Rope at root by calling pred against the accumulated weights and nodes traversed so far.
-Pred should evaluate to a truthy value if the weight or node should be traversed
-to the right, i.e. towards higher weights.
-The vector retuned is composed of the re-evaluated tree to the left of the
-split, the actual split leaf and a reassembled tree of the nodes cut off to the
-right of the traversal."
-  ([root pred] (rope-split root pred :length))
-  ([root pred measure-key]
-     (let [reassemble (fn [coll]
-                        (if (empty? coll)
-                          (rope)
-                          (->> coll (reduce conc) rope)))]
-       (loop [acc (), zipper (rope-zip root), total-weight 0]
-         (let [node (zip/node zipper), node-weight (-> node measure measure-key), new-weight (+ node-weight total-weight)]
-           (if (string? node)
-             (if (pred new-weight node)
-               (throw (IndexOutOfBoundsException. (str "Node index out of range: " new-weight)))
-               [(-> zipper zip/remove zip/root) node (reassemble acc)])
-             (let [left (zip/down zipper), right (zip/right left)]
-               (cond (nil? right) (recur acc left total-weight)
-                     (pred new-weight node) (recur acc right new-weight)
-                     :default
-                     (recur (cons (zip/node right) acc)
-                            (-> right (zip/replace nil) zip/left)
-                            total-weight)))))))))
+  "Split Rope at root by calling pred against the accumulated weights and nodes traversed so far
+
+Pred should evaluate to a truthy value whenever the weight or node should be
+traversed to the right, i.e. towards higher weights.
+The vector returned is composed of the re-evaluated tree to the left of the
+split, the actual split leaf, a reassembled tree of the nodes cut off to the
+right of the traversal and the measurement traversed, i.e. the weight of the
+left tree plus the split leaf."
+  [root pred]
+  (let [reassemble (fn [coll]
+                     (if (empty? coll)
+                       (rope)
+                       (->> coll (reduce conc) rope)))]
+    (loop [acc (), zipper (rope-zip (if (zero? (count root)) (rope "") root)),
+           total-weight (measurement)]
+      (let [node (zip/node zipper), node-weight (measure node), new-weight (measure+ node-weight total-weight)]
+        (if (string? node)
+          (if (pred new-weight node)
+            (throw (IndexOutOfBoundsException. (str "Node index out of range: " (pr-str new-weight))))
+            [(-> zipper zip/remove zip/root), node, (reassemble acc), new-weight])
+          (let [left (zip/down zipper), right (zip/right left)]
+            (cond (nil? right) (recur acc left total-weight)
+                  (pred new-weight node) (recur acc right new-weight)
+                  :default
+                  (recur (cons (zip/node right) acc)
+                         (-> right (zip/replace nil) zip/left)
+                         total-weight))))))))

 ;; Presumably faster than iterating till zip/end?
 (defn conjoin
-  "conj for Ropes. x is concatenated to the depth-first end, i.e. rightmost node of the Rope.
+  "conj for Ropes. x is concatenated to the depth-first end, i.e. rightmost node of the Rope
+
 Additional xs will be concatenated first."
   ([root x]
      (loop [zipper (rope-zip root)]
@@ -221,28 +234,54 @@
      (conjoin root (reduce conc x xs))))

 (defn- rope-split-at
-  "Split Rope at index, with the additional remaining string index as fourth vector element"
+  "Split Rope at index
+
+The additional remaining string index will be the fourth vector element"
   [root index]
-  (let [[left-rope string right-rope] (rope-split root (fn [weight _] (>= index weight)))
-        position (- index (count left-rope))]
-    [left-rope string right-rope position]))
+  (if (= (count root) index)
+    [root "" (rope) 0]
+    (let [[left-rope string right-rope _] (rope-split root (fn [weight _] (>= index (:length weight))))
+          position (- index (count left-rope))]
+      [left-rope string right-rope position])))
+
+(defn- split-lines
+  [s]
+  (seq (.split #"\n" s -1)))
+
+(defn- rope-split-at-line
+  "Split Rope at line
+
+The resulting vector consists of the left rope, lines left of the target line,
+then the same for everything right of the line."
+  [root index]
+  (let [[left-rope string right-rope _] (rope-split root (fn [weight _] (> index (:lines weight)))),
+        position (- index (:lines (measure left-rope))),
+        [left-lines [line & right-lines]] (split-at position (split-lines string))]
+    [left-rope left-lines line right-lines right-rope]))

 (defn insert
-  "Insert string in Rope at index"
-  [root index string]
-  (if (= index (count root))
-    (conjoin root string)
-    (let [[left-rope target right-rope position] (rope-split-at root index)]
-      (conc (conjoin left-rope (core/subs target 0 position) string (core/subs target position))
-            right-rope))))
-
-(defn subs
+  "Insert string in Rope at index or line/column"
+  ([root index string]
+     (if (= index (count root))
+       (conjoin root string)
+       (let [[left-rope target right-rope position] (rope-split-at root index)]
+         (conc (conjoin left-rope (subs target 0 position) string (subs target position))
+               right-rope))))
+  ([root line column string]
+     (let [[left-rope left-lines line right-lines right-rope] (rope-split-at-line root line)]
+       (conc (conjoin left-rope
+                      (apply str (interpose \n left-lines))
+                      "\n" (subs line 0 column) string (subs line column)
+                      (apply str (interpose \n right-lines)))
+             right-rope))))
+
+(defn report
   "Report in O(log n) time for Ropes, the equivalent of string subs"
   ([root start]
      (if (= start (count root))
        "" ; For consistency with "normal" subs
        (let [[_ string right-rope position] (rope-split-at root start)]
-         (conc (core/subs string position) right-rope))))
+         (conc (subs string position) right-rope))))
   ([root start end]
      {:pre [(>= (- end start) 0)]}
      (let [length (count root)]
@@ -252,26 +291,67 @@
             (let [[_ part1 right-rope position1] (rope-split-at root start)
                   length (- end start)
                   rest (- (count part1) position1)]
-              (cond (= length (+ rest (count right-rope))) (conc (core/subs part1 position1) right-rope)
+              (cond (= length (+ rest (count right-rope))) (conc (subs part1 position1) right-rope)
                     (> length rest)
                     (let [[middle-rope part2 _ position2] (rope-split-at right-rope (- length rest))]
-                      (conc (core/subs part1 position1) (conjoin middle-rope (core/subs part2 0 position2))))
-                    :default (core/subs part1 position1 (+ position1 length))))))))
+                      (conc (subs part1 position1) (conjoin middle-rope (subs part2 0 position2))))
+                    :default (subs part1 position1 (+ position1 length)))))))
+  ([root start-line start-column end-line end-column]
+     {:pre [(>= (- end-line start-line) 0)]}
+     (if (and (= start-line end-line)
+              (= start-column end-column))
+       ""
+       (report root (translate root start-line start-column) (translate root end-line end-column)))))
+
+(defn translate
+  ([root row column]
+     {:pre [(>= row 0) (>= column 0)]}
+     (if (> row (-> root measure :lines))
+       (throw (IndexOutOfBoundsException. (str "Line index out of range: " row)))
+       (let [[left-rope left-lines line right-lines right-rope] (rope-split-at-line root row),
+             offset (+ (count left-rope) (count (apply concat left-lines)) (count left-lines) column),
+             delta (- column (count line))]
+         (if (and (pos? delta) (empty? right-lines)
+                  (not (and (>= (count right-rope) delta)
+                            (zero? (first (translate right-rope delta))))))
+           (throw (IndexOutOfBoundsException. (str "String index out of range: " column)))
+           offset))))
+  ([root index]
+     {:pre [(>= index 0)]}
+     (let [[left-rope leaf _ rest] (rope-split-at root index),
+           lines (->> (subs leaf 0 rest) split-lines),
+           rope-weight (-> left-rope measure :lines),
+           weight (dec (count lines))]
+       (if (zero? weight)
+         (let [[_ _ line _ right-rope] (rope-split-at-line left-rope rope-weight)]
+           [rope-weight, (+ (count line) (count right-rope) (-> lines first count))])
+         [(+ rope-weight weight), (-> lines last count)]))))

 (defn delete
   "Delete the characters at interval [start..end] in the Rope"
-  [root start end]
-  {:pre [(>= (- end start) 0)]}
-  (cond
-   (= start end) root
-   (= end (count root))
-   (let [[left-rope part _ position] (rope-split-at root start)]
-     (conjoin left-rope (core/subs part 0 position)))
-   :default
-   (let [[left-rope part1 _ position1] (rope-split-at root start)
-         [_ part2 right-rope position2] (rope-split-at root end)]
-     (conc (conjoin left-rope (core/subs part1 0 position1) (core/subs part2 position2))
-           right-rope))))
+  ([root start end]
+     {:pre [(>= (- end start) 0)]}
+     (cond
+      (= start end) root
+      (= end (count root))
+      (let [[left-rope part _ position] (rope-split-at root start)]
+        (conjoin left-rope (subs part 0 position)))
+      :default
+      (let [[left-rope part1 _ position1] (rope-split-at root start)
+            [_ part2 right-rope position2] (rope-split-at root end)]
+        (conc (conjoin left-rope (subs part1 0 position1) (subs part2 position2))
+              right-rope))))
+  ([root start-line start-column end-line end-column]
+     {:pre [(>= (- end-line start-line) 0)]}
+     (if (and (= start-line end-line)
+              (= start-column end-column))
+       root
+       (delete root (translate root start-line start-column) (translate root end-line end-column)))))
+
+(defn delete-line
+  "Delete the line at index in the Rope"
+  [root index]
+  (delete root index 0 (inc index) 0))

 (deftype Rope [#^CharSequence left #^CharSequence right #^CharSequenceMeasurement weight #^int level]
   Measurable
@@ -279,7 +359,7 @@

   Treeish-2-3
   (split [this pred] (rope-split this pred))
-  (conc [this tree] (concat this tree))
+  (conc [this tree] (cat this tree))
   (left [_] left)
   (right [_] right)
   (depth [_] level)
@@ -296,16 +376,16 @@
   CharSequence
   (charAt [this index] (nth this index))
   (length [this] (count this))
-  (subSequence [this start end] (subs this start end))
+  (subSequence [this start end] (report this start end))
   (toString [this] (rope->string this)))

 (defmethod print-method Rope [rope writer]
   (print-simple (format "#<Rope %s>" (->> (measure rope) vals (join "/"))) writer))

 ; Must be defined here, else the dispatch on type/class will fail
-(defmethod concat [Rope String] [coll string]
+(defmethod cat [Rope String] [coll string]
   (let [right-child (right coll)]
     (if (and (= String (type right-child))
              (<= (+ (count right-child) (count string)) *leaf-cutoff-length*))
       (rope (left coll) (str right-child string))
-      (concat coll (rope string)))))
+      (cat coll (rope string)))))


RR: set size based on zoom level

RR: set size based on zoom level

--- src/hatti/views/map.cljs
+++ src/hatti/views/map.cljs
@@ -3,6 +3,7 @@
   (:require [cljs.core.async :refer [<! chan put! timeout]]
             [clojure.string :as string]
             [chimera.js-interop :refer [json->cljs]]
+            [chimera.seq :refer [in?]]
             [om.core :as om :include-macros true]
             [sablono.core :as html :refer-macros [html]]
             [hatti.constants :as constants :refer [_id _rank
@@ -337,14 +338,18 @@
         fitBounds (fn [geojson]
                     (when (and (.loaded mapboxgl-map)
                                (not (om/get-state owner :zoomed?)))
-                      (if-let [current-zoom (om/get-state owner :zoom)]
-                        (.setZoom mapboxgl-map current-zoom)
+                      (if (and (om/get-state owner :zoom)
+                               (om/get-state owner :loaded?))
+                        (.on mapboxgl-map "zoom" #(mu/set-zoom-level owner))
                         (mu/fitMapBounds
-                          mapboxgl-map (:id_string dataset-info) geojson))
+                         mapboxgl-map (:id_string dataset-info) geojson))
                       (om/set-state! owner :zoomed? true)))]
+    ;; Handle Map Events
     (.on mapboxgl-map "style.load" load-layers)
     (.on mapboxgl-map "render" #(fitBounds
                                  (om/get-state owner [:geojson])))
+    (.on mapboxgl-map "zoom" #(mu/set-zoom-level owner))
+
     ;; Handles change in geojson source when geofield is changed
     (when (and geojson (-> geojson :features count pos?))
       (if (or (.loaded mapboxgl-map) (om/get-state owner [:loaded?]))
@@ -359,8 +364,7 @@
       (om/set-state! owner :geojson geojson))
     (om/set-state! owner :mapboxgl-map mapboxgl-map)
     (om/set-state! owner :layer-id id_string)
-    (om/update! app-state [:map-page :mapboxgl-map] mapboxgl-map)
-    (.on mapboxgl-map "zoom" #(mu/set-zoom-level owner))))
+    (om/update! app-state [:map-page :mapboxgl-map] mapboxgl-map)))

 (defn mapboxgl-map
   "Map and markers. Initializes mapboxgl map + adds vector tile data to it.
@@ -495,23 +499,40 @@
   (reify
     om/IInitState
     (init-state [_]
-      {:slider-value 3})
+      {:slider-value 0
+       :zoom->bin? true
+       :value->size {0 500 1 250 2 100 3 50 4 25 5 10 6 5 7 1 8 0.5}})
+    om/IWillReceiveProps
+    (will-receive-props [_ next-props]
+      (when (om/get-state owner :zoom->bin?)
+        (when-let [map (-> next-props :map-page :mapboxgl-map)]
+          (let [zoom (.getZoom map)
+                value (cond
+                        (<= 0 zoom 2) 0
+                        (<= 3 zoom 5) 1
+                        (<= 6 zoom 8) 2
+                        (<= 9 zoom 11) 3
+                        (<= 12 zoom 14) 4
+                        (<= 15 zoom 17) 5
+                        (<= 18 zoom 20) 6)]
+            (om/set-state! owner :slider-value value)))))
+    om/IWillUpdate
+    (will-update [_ _ {:keys [slider-value value->size]}]
+      (om/update! cursor [:map-page :hexbins :cell-width]
+                  (get value->size slider-value)))
     om/IRenderState
-    (render-state [_ {:keys [slider-value]}]
+    (render-state [_ {:keys [slider-value value->size]}]
       "Render layer selector component w/css + expansion technique from
       leaflet layer control."
       (html
        (when show?
-         (let [values {0 500 1 250 2 100 3 50 4 25 5 10 6 5 7 1 8 0.5}
-               cell-size (or cell-width (get values slider-value))
+         (let [cell-size (or cell-width (get value->size slider-value))
                update-cell-width (fn [e]
                                    (let
                                     [v (js/parseInt (.. e -target -value))]
-                                     (om/set-state! owner :slider-value v)
-                                     (om/update!
-                                      cursor
-                                      [:map-page :hexbins :cell-width]
-                                      (get values v))))
+                                     (om/update-state!
+                                      owner #(assoc % :zoom->bin? false
+                                                    :slider-value v))))
                below-1km? (> 1 cell-size)]
            [:div.map-overlay.mapboxgl-ctrl-bottom-left
             [:div.map-overlay-inner


update for getting comparison information, correct issues with split-filter-fastqs

--- src/aerobio/htseq/wgseq.clj
+++ src/aerobio/htseq/wgseq.clj
@@ -29,6 +29,7 @@
 (ns aerobio.htseq.wgseq
   [:require
    [clojure.string :as cljstr]
+   [clojure.data.csv :as csv]

    [aerial.fs :as fs]
    [aerial.utils.string :as str]
@@ -92,14 +93,46 @@
             (when (and (> gcnt min-len) (>= qc% sqc%))
               (vswap! gdcnt #(inc (long %)))
               (bufiles/write-fqrec
-               ot [(str id "\n")
-                   (str gsq "\n")
-                   (str "+ " gcnt " " qc% "\n")
-                   (str gqc "\n")])))
+               ot [id gsq (str "+ " gcnt " " qc%) gqc])))
           (recur (bufiles/read-fqrecs inf rec-chunk-size)))))))

+(defn split-filter-fastqs
+  [eid]
+  (let [fqbase (cmn/get-exp-info eid :fastq)
+        fqs (fs/directory-files fqbase "fastq.gz")
+        sample-dir (cmn/get-exp-info eid :samples)]
+    (cmn/ensure-sample-dirs
+     (cmn/get-exp-info eid :base)
+     (cmn/get-exp-info eid :illumina-sample-xref))
+    (doseq [fq fqs]
+      (filter-fastq
+       fq :baseqc% 0.96 :sqc% 0.97 :marker "CTGTCTC"
+       :outdir sample-dir))))

+
+(defn get-comparison-files-
+  ([eid]
+   (get-comparison-files- eid "ComparisonSheet.csv"))
+  ([eid comp-filename]
+   (let [samps (cmn/get-exp-info eid :samples)
+         outs  (cmn/get-exp-info eid :out)
+         refbase (cmn/get-exp-info eid :refs)
+         refxref (cmn/get-exp-info eid :ncbi-sample-xref)
+         compvec (->> comp-filename
+                      (fs/join (pams/get-params :nextseq-base) eid)
+                      slurp csv/read-csv rest)
+         quads (map (fn[[samp ref]]
+                      [(-> (fs/join samps (str samp "_*.fastq.gz"))
+                           fs/glob sort)
+                       (fs/join refbase (str (refxref ref) ".gbk"))
+                       (fs/join outs samp)])
+                    compvec)]
+     quads)))
+
+(defmethod cmn/get-comparison-files :wgseq
+  [_ & args]
+  (apply get-comparison-files- args))

 (comment