comment changes

comment changes

--- src/strictly_specking/annotated_pprint.clj
+++ src/strictly_specking/annotated_pprint.clj
@@ -191,21 +191,21 @@
   (reduce #(annotate-path %1 (first %2) (second %2))
           data path-to-annotation-map))

-(ansi-util/with-ansi-when true
+#_(ansi-util/with-ansi-when true
     (pp/with-pprint-dispatch error-path-dispatch
       (pp/pprint
        (annotate-path-only test-data
-                           [:cljsbuild :builds 0 #_:source-paths-set]
+                           [:cljsbuild :builds 0 :source-paths-set]
                            {:abbrev true
-                            :comments {:source-paths {
+                            :comments {"src" {
                                           :key-colors [:green]
-                                          :value-colors [:red]
+                                          :value-colors [:bright]
                                           :comment-colors [:magenta]
                                           :comment " is screwwed"
                                           }
-                                       #_"tests" #_{
+                                       "tests" {
                                           :key-colors [:green]
-                                          :value-colors [:red]
+                                          :value-colors [:bright]
                                           :comment-colors [:magenta]
                                           :comment " is screwwed"
                                           }}}))))


Fix issue so it works when settings file doesn't exist

--- lein-template/src/leiningen/new/modular.clj
+++ lein-template/src/leiningen/new/modular.clj
@@ -167,11 +167,11 @@

                              }))

-        settings (when-let [f (io/file (System/getProperty "user.home")
-                                       ".lein/modular.edn")]
-                   (read
-                    (indexing-push-back-reader
-                     (java.io.PushbackReader. (io/reader f)))))
+        settings (let [f (io/file (System/getProperty "user.home") ".lein/modular.edn")]
+                   (when (.exists f)
+                     (read
+                      (indexing-push-back-reader
+                       (java.io.PushbackReader. (io/reader f))))))

         data {:name name
               :year (str (.get (java.util.Calendar/getInstance) java.util.Calendar/YEAR))


Swap around checks in `is-game-over?'

Swap around checks in `is-game-over?'

--- src/tttclj/core.clj
+++ src/tttclj/core.clj
@@ -89,9 +89,7 @@

 (defn is-game-over? [game]
   "Returns `true' if the game is finished, nil otherwise"
-  (if (winner game)
+  (if (not-any? #{:-} (:tiles game))
     true
-    (->> (:tiles game)
-         (keep #(= :- %))
-         (not-any? true?))))
+    (not (nil? (winner game)))))


Alter bind as suggested by @jakecraige

Alter bind as suggested by @jakecraige

--- src/pani/cljs/core.cljs
+++ src/pani/cljs/core.cljs
@@ -82,7 +82,7 @@
    (let [c (walk-root root korks)]
      (.on c (clojure.core/name type)
           #(when-let [v (clj-val %1)]
-             (cb v))))))
+             (cb {:val v, :name (name %1)}))))))

 (defn transact!
   "Use the firebase transaction mechanism to update a value atomically"


Inexplicable misery

Inexplicable misery

Despite the :refer-clojure exclusion, usage
of set! was breaking compilation on this side.

--- src/pani/cljs/core.cljs
+++ src/pani/cljs/core.cljs
@@ -89,7 +89,7 @@
    (.set root (clj->js val)))

   ([root korks val]
-   (set! (walk-root root korks) val)))
+   (.set (walk-root root korks) (clj->js val))))

 (defn push!
   "Set the value at the given root"


fix update-in

fix update-in

--- src/pc/http/datomic.clj
+++ src/pc/http/datomic.clj
@@ -99,7 +99,7 @@
 (defmethod translate-datom :access-request/cust-ref [db d]
   (-> d
     (assoc :a :access-request/cust)
-    (update-in d [:v] #(:cust/email (d/entity db %)))))
+    (update-in [:v] #(:cust/email (d/entity db %)))))

 (defmethod translate-datom :permission/document-ref [db d]
   (-> d


add details-fields

add details-fields

--- test/metabase/mock/schema_per_customer.clj
+++ test/metabase/mock/schema_per_customer.clj
@@ -74,6 +74,7 @@

                                    :else
                                    #{}))
+          :details-fields       (constantly [])
           :features             (constantly #{:foreign-keys})}))

 (driver/register-driver! :schema-per-customer (SchemaPerCustomerDriver.))


Fix midi note-on

Fix midi note-on

--- src/webcv/midi.cljs
+++ src/webcv/midi.cljs
@@ -27,7 +27,7 @@
   [_ src dest {::synthdef/keys [param-name]}]
   (async/go-loop []
     (let [msg (async/<! src)]
-      (oset!+ dest param-name (:note msg))
+      (oset!+ dest (str param-name ".value") msg)
       (recur))))

 ;;
@@ -42,10 +42,10 @@
         ([] (rf))
         ([result] (rf result))
         ([result midi]
-         (let [{:keys [type note]} midi
-               op (if (= :note-on type) conj #(remove #{%2} %1))
+         (let [{:keys [type note velocity]} midi
+               note-on (> velocity 0)
+               op (if note-on conj #(remove #{%2} %1))
                down (op @v-down note)]
-           (print down)
            (vreset! v-down (into [] down))
            (if-let [output (priority-fn down)]
              (rf result output)
@@ -69,14 +69,14 @@
         ([] (rf))
         ([result] (rf result))
         ([result midi]
-         (let [{:keys [type velo]} midi
-               note-on (= :note-on type)
+         (let [{:keys [type velocity]} midi
+               note-on (and (= :note type) (> 0 velocity))
                prev-down-count @v-down-count]
            (vswap! v-down-count (if note-on inc dec))
            (if (or (and note-on retrigger (> 1 prev-down-count))
                    (and note-on (= 0 prev-down-count))
                    (and (not note-on) (= 1 prev-down-count)))
-             (rf result velo)
+             (rf result velocity)
              result)))))))

 (def midi-x-gate


open web browser in dev

open web browser in dev

--- src/platinator/core.clj
+++ src/platinator/core.clj
@@ -6,7 +6,8 @@
     [compojure.route :as route]
     [org.httpkit.server :refer [run-server]]
     [clojure.string :as string]
-    [platinator.reload :as reload]))
+    [platinator.reload :as reload]
+    [clojure.java.browse :as browse]))

 (defroutes app-routes
   (GET "/" [] "Platinator")
@@ -28,4 +29,5 @@
   "Start a dev server with live-reload of namespaces"
   []
   (reload/start-nstracker)
+  (browse/browse-url "http://localhost:8080/")
   (-main 8080))


Fix a StackOverflow in `(sendmail-send)`

--- src/postal/sendmail.clj
+++ src/postal/sendmail.clj
@@ -65,7 +65,7 @@

 (defn sendmail-send
   ([msg]
-     (sendmail-send (find-sendmail)))
+     (sendmail-send msg (find-sendmail)))
   ([msg sendmail]
       (let [mail (sanitize (message->str msg))
             cmd (concat


cleanup, rename some things, still working on emitting namespaced elements and attrs correctly.

--- src/rapscallion/xml.clj
+++ src/rapscallion/xml.clj
@@ -16,22 +16,28 @@
 (defprotocol ElementAccessor
   (tag [this] "Return the tag of the element")
   (attrs [this] "Return a map of the attributes of the element")
-  (content [this] "Return a sequence of children of the element")
+  (content [this] "Return a sequence of children of the element"))
+
+(defprotocol XmlNamespaced
   (uri [this] "Return the namespace URI of the element")
-  (prefix [this] "Returns the prefix that should be used when emitting the element"))
+  (prefix [this] "Returns the prefix that should be used when emitting the element. Can return nil to indicate no preference."))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Records for XML node types

 (defrecord Element [tag attrs content uri]
+
   ElementAccessor
   (tag [this] tag)
   (attrs [this] attrs)
   (content [this] content)
+
+  XmlNamespaced
   (uri [this] uri)
   (prefix [this]
-    (when-let [md (meta this)])))
+    (when-let [md (meta this)]
+      (get-in md [:xmlns uri]))))

 (defrecord Comment [^String text])

@@ -99,9 +105,9 @@

 (defn attrs->map
-  [^Attributes attrs namespaces]
+  [^Attributes attrs xmlns-aware]
   (let [attr-key
-        (if namespaces
+        (if xmlns-aware
           (fn [^Attributes attrs ^Long i]
             (let [uri (.getURI attrs i)
                   q-name (.getQName attrs i)]
@@ -135,7 +141,7 @@
     [:comment text]
   "
   [f & [opts]]
-  (let [{:keys [namespaces line-numbers]} opts
+  (let [{:keys [xmlns-aware line-numbers]} opts
         locator (atom nil)
         with-line-numbers (fn [evt]
                             (if-let [^Locator loc @locator]
@@ -156,7 +162,7 @@

       ;; Elements
       (startElement [uri local-name q-name attrs]
-        (f [:start-element uri local-name q-name (attrs->map attrs namespaces)]))
+        (f [:start-element uri local-name q-name (attrs->map attrs xmlns-aware)]))
       (endElement [uri local-name q-name]
         (f [:end-element uri local-name q-name]))

@@ -215,7 +221,7 @@
   "Given a source of XML, returns a sequence of events, in the form of
    vectors of [type data ...]. See sax-handler for details."
   [in & [opts]]
-  (let [{:keys [namespaces]} opts
+  (let [{:keys [xmlns-aware]} opts
         ^InputSource in (as-input-source in)
         parser          (XMLReaderFactory/createXMLReader) ;TODO - make this pluggable
         [put event-seq] (pipe/pipe {:capacity 4096})
@@ -223,14 +229,18 @@

     (.setContentHandler parser handler)

-    (when namespaces
+    (when xmlns-aware
       ;; Set the "lexical-handler" property in order to get
       ;; start-prefix-mapping & end-prefix-mapping events.
-      (.setProperty parser "http://xml.org/sax/properties/lexical-handler" handler)
-
-      ;; Setting this to true means that undeclared namespace-prefixes
-      ;; will be an error.
-      (.setFeature parser "http://xml.org/sax/features/namespaces" namespaces))
+      (.setProperty parser
+                    "http://xml.org/sax/properties/lexical-handler"
+                    handler))
+
+    ;; Setting this to true means that undeclared namespace-prefixes
+    ;; will be an error.
+    (.setFeature parser
+                 "http://xml.org/sax/features/namespaces"
+                 (if xmlns-aware true false))

     ;; Run the SAX parser in a thread.
     (future
@@ -293,20 +303,18 @@
   "
   [events & [opts]]
   ;; TODO - this function is way too busy
-  (let [{:keys [namespaces]} opts
+  (let [{:keys [xmlns-aware]} opts

         ;; Memoize the metadata maps
-        md-map-with-prefix
-        (let [cache (atom nil)]
+        element-metadata
+        (memoize
           (fn [md-map prefix]
-            (if-let [m (get-in @cache [md-map prefix])]
-              m
-              (let [new-map (assoc md-map :prefix prefix)]
-                (swap! cache assoc-in [md-map prefix] new-map)
-                new-map))))
+            (if prefix
+              (assoc md-map :prefix prefix)
+              md-map)))

         make-element
-        (if namespaces
+        (if xmlns-aware
           (fn [[_ uri local-name q-name attrs] content md-map]
             (let [[prefix tag] (string/split q-name #":" 2)
                   prefix (if tag prefix nil)]
@@ -315,9 +323,7 @@
                           attrs
                           content
                           uri)
-                (if prefix
-                  (md-map-with-prefix md-map prefix)
-                  md-map))))
+                (element-metadata md-map prefix))))
           (fn [[_ _ _ q-name attrs] content _]
             (Element. (keyword q-name)
                       attrs
@@ -392,7 +398,7 @@

 ;; New default parse options.
 (def default-parse-options
-  {:namespaces              true
+  {:xmlns-aware             true
    :keep-whitespace         false
    :comments                true
    :cdata                   true
@@ -402,7 +408,7 @@

 ;; For backward-compatibility. Options for parsing clojure.xml-style.
 (def old-parse-options
-  {:namespaces              false
+  {:xmlns-aware             false
    :keep-whitespace         false
    :comments                false
    :cdata                   false
@@ -435,7 +441,7 @@
        If true, the parser will put line-numbers and column-numbers
        in the metadata of elements, when supported by the SAX parser.

-     :namespaces
+     :xmlns-aware
        Sets namespace-awareness in the SAX parser. See below.

    Namespace-awareness has the following effects:
@@ -449,7 +455,7 @@

    Specifically, setting this when parsing causes the following
    differences in the resulting tree, where each point below lists the
-   effects of setting :namespaces to true (t) or false (f):
+   effects of setting :xmlns-aware to true (t) or false (f):

     * xmlns declarations:
        t: stored in metadata as :xmlns-decls
@@ -490,7 +496,7 @@

   (let [;; Use defaults for options unless overridden.
         opts (merge *parse-options* opts)
-        {:keys [namespaces
+        {:keys [xmlns-aware
                 comments cdata processing-instructions
                 keep-whitespace]} opts

@@ -507,7 +513,7 @@
                          (when-not processing-instructions [:processing-instruction])
                          ;; Maybe don't need this line (the parser
                          ;; won't emit these anyway, right?):
-                         (when-not namespaces [:start-prefix-mapping :end-prefix-mapping])
+                         (when-not xmlns-aware [:start-prefix-mapping :end-prefix-mapping])
                          ])]
             (if ignored-types (apply ignore e ignored-types) e))

@@ -538,6 +544,42 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Emitting XML

+(def ^:dynamic *emitter-state* nil)
+
+(defn update-emitter-state [elt]
+  )
+
+(defn valid-prefix?
+  "Returns true if the given prefix is valid for the uri, for the current value
+   of *emitter-state*."
+  [prefix uri]
+  (let [declared-prefixes (get-in *emitter-state* [:prefixes uri])]
+    (some #(= prefix %) declared-prefixes)))
+
+
+(defprotocol XMLPrefix
+  (prefix-for [this] "Returns the prefix to use for "))
+
+(extend-protocol XMLPrefix
+
+  Element
+  (prefix-for [elt]
+    (if-let [uri (uri elt)]
+      (or (:prefix (meta elt))
+          (peek (get-in *emitter-state* [:prefixes uri])))))
+
+  ;; Namespaced attribute
+  clojure.lang.IPersistentVector
+  (prefix-for [[name uri :as attr]]
+    ())
+
+  ;; Non-namespaced attribute
+  clojure.lang.Keyword
+  (prefix-for [_]
+    nil)
+  )
+
+
 (defprotocol XMLWritable
   (emit-xml [this ^Writer out]))

@@ -556,28 +598,37 @@

 (extend-protocol XMLWritableAttr
   clojure.lang.Keyword
-  (emit-attr [kwd val ^Writer out]
+  (emit-attr [kwd val out]
+    (emit-attr (name kwd) val out))
+
+  String
+  (emit-attr [name val ^Writer out]
     (doto out
-      (.write (name kwd))
-      (.write "=\"")
+      (.write name)
+      (.write "='")
       (.write (xml-escape-attr (str val)))
-      (.write \")))
+      (.write "'")))

   clojure.lang.IPersistentVector
-  (emit-attr [[name uri] ]))
-
-(defn emit-element [^Element e ^Writer out]
-  (let [tag (tag e)
-        attrs (attrs e)
-        content (content e)
-        prefix (prefix e)
+  (emit-attr [[kwd uri :as attr] val ^Writer out]
+    (if uri
+      (if-let [prefix (:prefix (meta attr))]
+        (emit-attr (str prefix  \: (name kwd)) val out))
+      (emit-attr kwd val out))))
+
+(defn emit-element
+  [elt ^Writer out]
+  (let [tag (tag elt)
+        attrs (attrs elt)
+        content (content elt)
+        prefix (prefix-for elt)
         tagname (str prefix (if prefix \:) (name tag))]
     (doto out
       (.write "<")
       (.write tagname))
     (doseq [[k v] attrs]
       (when-not (nil? v)
-        (.write " ")
+        (.write out " ")
         (emit-attr k v out)))
     (if (empty? content)
       (.write out "/>")
@@ -610,7 +661,7 @@
   (let [{:keys [target text]} pi]
     ;; TODO - validate target: http://www.w3.org/TR/REC-xml/#sec-pi
     (when (.contains text "?>")
-      (throw (IllegalArgumentException. "Illegal end sequence, \"?>\", in processing instruction." target)))
+      (throw (IllegalArgumentException. "Illegal end sequence, \"?>\", in processing instruction.")))
     (doto out
       (.write "<?")
       (.write target)
@@ -673,5 +724,6 @@
        (emit-xml nodes to)
        (str to)))
   ([nodes to]
-     (emit-xml nodes to)))
-
+     (binding [*emitter-state* (atom nil)]
+       (emit-xml nodes to))))
+


Added new wrappers to start a game

Added new wrappers to start a game

--- src/retro_fever/core.cljs
+++ src/retro_fever/core.cljs
@@ -3,7 +3,8 @@
   (:require [cljs.core.async :refer [<! put! alts! chan timeout]]
             [retro-fever.util :as util]
             [retro-fever.asset :as asset]
-            [retro-fever.stats :as stats]))
+            [retro-fever.stats :as stats]
+            [retro-fever.scene :as scene]))

 ; Atom for holding engine specific values
 (def app (atom {:game {:canvas nil :loop nil}}))
@@ -55,8 +56,30 @@
   "Wrapper function to ensure resources are loaded before they are used"
   (go (loop []
         (if (asset/resources-loaded?)
-          (do (asset/load-dependent-assets)
+          (do (asset/load-dependencies)
               (doseq [f fns]
                 (f)))
           (do (<! (timeout 100))
               (recur))))))
+
+(defmulti game type)
+
+(defmethod game js/Function
+  [update-fn render-fn & options]
+  (let [options-map (reduce (fn [r [k v]] (assoc r k v))
+                      {} (partition 2 options))
+        opts (merge {:ups 60}
+                    options-map)]
+    (game-loop (/ 1000 (:ups opts))
+               update-fn render-fn)))
+
+(defmethod game cljs.core/Atom
+  [game-state & options]
+  (let [scene-view (if (vector? (first options)) (first options) nil)
+        options (if scene-view (rest options) options)]
+    (game
+      (if (empty? scene-view)
+        (fn [] (swap! game-state scene/update))
+        (fn [] (swap! game-state update-in scene-view scene/update)))
+      (fn [context] (scene/render (get-in @game-state scene-view) context))
+      options)))


add support for size based log rotation

add support for size based log rotation

--- src/riemann/logging.clj
+++ src/riemann/logging.clj
@@ -12,6 +12,8 @@
            (net.logstash.log4j JSONEventLayoutV1 JSONEventLayout)
            (org.apache.log4j.spi RootLogger))
   (:import (org.apache.log4j.rolling TimeBasedRollingPolicy
+                                     SizeBasedTriggeringPolicy
+                                     FixedWindowRollingPolicy
                                      RollingFileAppender))
   (:import org.apache.commons.logging.LogFactory)
   (:require wall.hack))
@@ -60,15 +62,19 @@
   :files           A list of files to log to. If provided, a seq is expected
                    containing maps with a :path and an optional :layout key
                    which can be any of: :riemann, :json-event :json-eventv1
-
+  :logsize-rotate  If size(bytes) is specified rotate based on that size
+                   otherwise use default time based.
   Example:

-  (init {:console false :file \"/var/log/riemann.log\"})"
+  (init {:console false :file \"/var/log/riemann.log\"})
+    or
+  (init {:console false :file \"/var/log/riemann.log\" :logsize-rotate 1000000000})"
   [& opts]
   ;; Reset loggers
   (let [{:keys [file
                 files
-                console-layout]
+                console-layout
+                logsize-rotate]
          :as opts} (if (and (= 1 (count opts))
                             (map? (first opts)))
                      (first opts)
@@ -80,33 +86,67 @@
       (.addAppender logger (ConsoleAppender. (get-layout console-layout))))

     (when file
-      (let [rolling-policy (doto (TimeBasedRollingPolicy.)
-                             (.setActiveFileName file)
-                             (.setFileNamePattern
-                              (str file ".%d{yyyy-MM-dd}.gz"))
-                             (.activateOptions))
-            log-appender (doto (RollingFileAppender.)
-                           (.setRollingPolicy rolling-policy)
-                           (.setLayout (get-layout :riemann))
-                           (.activateOptions))]
-        (.addAppender logger log-appender)))
+      (if logsize-rotate
+        (let [rolling-policy (doto (FixedWindowRollingPolicy.)
+                               (.setActiveFileName file)
+                               (.setMaxIndex 5)
+                               (.setFileNamePattern
+                                (str file "%d{yyyy-MM-dd}.%i.gz"))
+                               (.activateOptions))
+              triggering-policy (doto (SizeBasedTriggeringPolicy.)
+                                  (.setMaxFileSize logsize-rotate)
+                                  (.activateOptions))
+              log-appender (doto (RollingFileAppender.)
+                             (.setRollingPolicy rolling-policy)
+                             (.setTriggeringPolicy triggering-policy)
+                             (.setLayout (get-layout :riemann))
+                             (.activateOptions))]
+          (.addAppender logger log-appender))
+
+        (let [rolling-policy (doto (TimeBasedRollingPolicy.)
+                               (.setActiveFileName file)
+                               (.setFileNamePattern
+                                (str file ".%d{yyyy-MM-dd}.gz"))
+                               (.activateOptions))
+              log-appender (doto (RollingFileAppender.)
+                             (.setRollingPolicy rolling-policy)
+                             (.setLayout (get-layout :riemann))
+                             (.activateOptions))]
+          (.addAppender logger log-appender))))

     (when files
       (doseq [{:keys [path layout]} files
               :let [layout (get-layout layout)]]
-        (let [rolling-policy (doto (TimeBasedRollingPolicy.)
-                             (.setActiveFileName path)
-                             (.setFileNamePattern
-                              (str path ".%d{yyyy-MM-dd}.gz"))
-                             (.activateOptions))
-            log-appender (doto (RollingFileAppender.)
-                           (.setRollingPolicy rolling-policy)
-                           (.setLayout layout)
-                           (.activateOptions))]
-        (.addAppender logger log-appender))))
+        (if logsize-rotate
+          (let [rolling-policy (doto (FixedWindowRollingPolicy.)
+                                 (.setActiveFileName file)
+                                 (.setMaxIndex 5)
+                                 (.setFileNamePattern
+                                  (str file "%d{yyyy-MM-dd}.%i.gz"))
+                                 (.activateOptions))
+                triggering-policy (doto (SizeBasedTriggeringPolicy.)
+                                    (.setMaxFileSize logsize-rotate)
+                                    (.activateOptions))
+                log-appender (doto (RollingFileAppender.)
+                               (.setRollingPolicy rolling-policy)
+                               (.setTriggeringPolicy triggering-policy)
+                               (.setLayout (get-layout :riemann))
+                               (.activateOptions))]
+            (.addAppender logger log-appender))

-    ;; Set levels.
-    (.setLevel logger Level/INFO)
+          (let [rolling-policy (doto (TimeBasedRollingPolicy.)
+                                 (.setActiveFileName path)
+                                 (.setFileNamePattern
+                                  (str path ".%d{yyyy-MM-dd}.gz"))
+                                 (.activateOptions))
+                log-appender (doto (RollingFileAppender.)
+                               (.setRollingPolicy rolling-policy)
+                               (.setLayout layout)
+                               (.activateOptions))]
+            (.addAppender logger log-appender)))))
+
+      ;; Set levels.
+      (.setLevel logger Level/INFO)

     (set-level "riemann.client" Level/DEBUG)
     (set-level "riemann.server" Level/DEBUG)


Logic for if extract-pager-urls returns nil.

--- project/scrape-trs/src/scrape_trs/core.clj
+++ project/scrape-trs/src/scrape_trs/core.clj
@@ -36,7 +36,7 @@
   ""
   [implementation list-page]
   (let [pager-urls (.extract-pager-urls implementation list-page)
-        list-pages (map slurp pager-urls)
+        list-pages (if pager-urls (map slurp pager-urls) [list-page])
         trip-report-urls (mapcat #(.extract-trip-report-urls implementation %)
                                  list-pages)
         trip-reports (map #(.extract-trip-report implementation %1 %2)


Functions to export products, chapters, groups or components into CSV output

--- src/hurvinek/exporter.clj
+++ src/hurvinek/exporter.clj
@@ -103,3 +103,31 @@
                                    :id     (:id component)
                                    :name   (:name component)}})})))

+(defn products->csv
+    "Convert list of products into CSV file."
+    [products]
+    (data->csv (cons ["Product ID" "Product name" "Description"]
+                     (for [product products]
+                          [(:id product) (:name product) (:description product)]))))
+
+(defn chapters->csv
+    "Convert list of chapters into CSV file."
+    [chapters]
+    (data->csv (cons ["Chapter ID" "Chapter name"]
+                     (for [chapter chapters]
+                          [(:id chapter) (:name chapter)]))))
+
+(defn groups->csv
+    "Convert list of groups into CSV file."
+    [groups]
+    (data->csv (cons ["Group ID" "Group name"]
+                     (for [group groups]
+                          [(:id group) (:name group)]))))
+
+(defn components->csv
+    "Convert list of components into CSV file."
+    [components]
+    (data->csv (cons ["Component ID" "Component name"]
+                     (for [component components]
+                          [(:id component) (:name component)]))))
+


Beefed up string cleaner.

Beefed up string cleaner.

--- src/simulacrum/util.clj
+++ src/simulacrum/util.clj
@@ -78,7 +78,13 @@
   (string/replace text #"\s+\n\s+" " "))

 (defn remove-trailing-non-ascii [text]
-  (string/replace text (str (char 65533)) ""))
+  (string/replace
+    (string/replace
+      (string/replace
+        text
+        #"^\n\s+$" "")
+      (str (char 160)) "")
+    (str (char 65533)) ""))

 (defn clean-string [text]
   (remove-trailing-non-ascii


♻ Read the current user ID from session

♻ Read the current user ID from session

Why:
- Avoids the need for a database connection in many situations.

--- src/territory_bro/api.clj
+++ src/territory_bro/api.clj
@@ -86,8 +86,8 @@
                             (fix-user-for-liberator)
                             (assoc :authenticated (not (nil? auth/*user*))))})))

-(defn- current-user-id [conn]
-  (let [id (:user/id (user/get-by-subject conn (:sub auth/*user*)))]
+(defn- current-user-id []
+  (let [id (:user/id auth/*user*)]
     (assert id)
     id))

@@ -98,7 +98,7 @@
       (assert (not (str/blank? name)) ; TODO: test this
               {:name name})
       (db/with-db [conn {}]
-        (let [user-id (current-user-id conn)]
+        (let [user-id (current-user-id)]
           (binding [events/*current-user* user-id]
             (let [cong-id (congregation/create-congregation! conn name)]
               (congregation/grant! conn cong-id user-id :view-congregation)
@@ -109,11 +109,10 @@
 (defn list-congregations [request]
   (auth/with-authenticated-user request
     (require-logged-in!)
-    (db/with-db [conn {:read-only? true}]
-      (ok (->> (congregation/get-my-congregations (projections/cached-state) (current-user-id conn))
-               (map (fn [congregation]
-                      {:id (:congregation/id congregation)
-                       :name (:congregation/name congregation)})))))))
+    (ok (->> (congregation/get-my-congregations (projections/cached-state) (current-user-id))
+             (map (fn [congregation]
+                    {:id (:congregation/id congregation)
+                     :name (:congregation/name congregation)}))))))

 (def ^:private format-key-for-api (memoize (comp csk/->camelCaseString name)))

@@ -129,7 +128,7 @@
     (require-logged-in!)
     (db/with-db [conn {:read-only? true}]
       (let [cong-id (UUID/fromString (get-in request [:params :congregation]))
-            user-id (current-user-id conn)
+            user-id (current-user-id)
             state (projections/cached-state)
             congregation (congregation/get-my-congregation state cong-id user-id)]
         (when-not congregation
@@ -149,7 +148,7 @@
 (defn- api-command! [conn command]
   (let [command (assoc command
                        :command/time ((:now config/env))
-                       :command/user (current-user-id conn))]
+                       :command/user (current-user-id))]
     (try
       (congregation/command! conn (projections/cached-state)
                              command)
@@ -181,23 +180,22 @@
 (defn download-qgis-project [request]
   (auth/with-authenticated-user request
     (require-logged-in!)
-    (db/with-db [conn {:read-only? true}]
-      (let [cong-id (UUID/fromString (get-in request [:params :congregation]))
-            user-id (current-user-id conn)
-            congregation (congregation/get-my-congregation (projections/cached-state) cong-id user-id)
-            gis-user (gis-user/get-gis-user (projections/cached-state) cong-id user-id)]
-        (when-not gis-user
-          (forbidden! "No GIS access"))
-        (let [content (qgis/generate-project {:database-host (:gis-database-host config/env)
-                                              :database-name (:gis-database-name config/env)
-                                              :database-schema (:congregation/schema-name congregation)
-                                              :database-username (:gis-user/username gis-user)
-                                              :database-password (:gis-user/password gis-user)
-                                              :database-ssl-mode (:gis-database-ssl-mode config/env)})
-              file-name (qgis/project-file-name (:congregation/name congregation))]
-          (-> (ok content)
-              (response/content-type "application/octet-stream")
-              (response/header "Content-Disposition" (str "attachment; filename=\"" file-name "\""))))))))
+    (let [cong-id (UUID/fromString (get-in request [:params :congregation]))
+          user-id (current-user-id)
+          congregation (congregation/get-my-congregation (projections/cached-state) cong-id user-id)
+          gis-user (gis-user/get-gis-user (projections/cached-state) cong-id user-id)]
+      (when-not gis-user
+        (forbidden! "No GIS access"))
+      (let [content (qgis/generate-project {:database-host (:gis-database-host config/env)
+                                            :database-name (:gis-database-name config/env)
+                                            :database-schema (:congregation/schema-name congregation)
+                                            :database-username (:gis-user/username gis-user)
+                                            :database-password (:gis-user/password gis-user)
+                                            :database-ssl-mode (:gis-database-ssl-mode config/env)})
+            file-name (qgis/project-file-name (:congregation/name congregation))]
+        (-> (ok content)
+            (response/content-type "application/octet-stream")
+            (response/header "Content-Disposition" (str "attachment; filename=\"" file-name "\"")))))))

 (defroutes api-routes
   (GET "/" [] (ok "Territory Bro"))


Minor fix to ignore date formatting

Minor fix to ignore date formatting

--- scrape-n-mail/src/scrape_n_mail/core.cljs
+++ scrape-n-mail/src/scrape_n_mail/core.cljs
@@ -22,8 +22,9 @@

 (def goog-datetime (fmt/formatter "MM/dd/YYYY HH:mm:ss"))

-(defn parse-sheet [sheet-values]
-  (map (fn [dt & rst] (into [(fmt/parse goog-datetime dt)] rst)) sheet-values) )
+; this is not currently used
+; (defn parse-sheet [sheet-values]
+;  (map (fn [dt & rst] (into [(fmt/parse goog-datetime dt)] rst)) sheet-values) )

 ; This works - we need to deal with the fact that it's js!
 ; (map #(fmt/parse goog-datetime (aget % 0)) [first-row])
@@ -53,7 +54,9 @@
   (merge
     (let [processed-group (and (not (nil? is-group?)) (starts-with? is-group? "YES"))]
       ; Our required fields
-      {::when-submitted (fmt/parse goog-datetime timestamp)
+      ; I'm not actually using the timestamp now (just manually editing the
+      ; spreadsheet) so this is rather unnecessary (and brittle)
+      {::when-submitted timestamp  ; (fmt/parse goog-datetime timestamp)
        ::held-name-altar (trim name-for-altar)
        ; We could make this more robust - but should be fine for now
        ::is-group-or-class processed-group


fix subworkflows in face of includeKey (#1473)

--- src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
+++ src/cljs/main/broadfcui/page/workspace/monitor/workflow_details.cljs
@@ -34,7 +34,7 @@
      (str gcs-uri))))

 (defonce default-metadata-includes ["backendLogs" "backendStatus" "end" "executionStatus" "callCaching:hit" "failures"
-                                    "id" "inputs" "jobId" "outputs" "start" "status" "stderr" "stdout" "submission"
+                                    "id" "inputs" "jobId" "outputs" "start" "status" "stderr" "stdout" "submission" "subworkflowId"
                                     "submittedFiles:inputs" "workflowLog" "workflowName" "workflowRoot"])

 (defonce metadata-timing-includes ["attempt" "description" "end" "endTime" "executionEvents" "executionStatus"
@@ -262,7 +262,7 @@
         (endpoints/call-ajax-orch
           {:endpoint
            (endpoints/get-workflow-details
-             (:workspace-id props) (:submission-id props) (:workflow-id props) default-metadata-includes)
+             (:workspace-id props) (:submission-id props) (:workflow-id props))
            :on-done (fn [{:keys [success? get-parsed-response status-text raw-response]}]
                       (swap! state assoc :server-response
                              {:success? success?


Fixed parallel execution

Fixed parallel execution

--- src/video_server/util.clj
+++ src/video_server/util.clj
@@ -80,10 +80,10 @@
                 ~@body))
             (split-equally ~thread-count ~coll))))

-(defn parall
+(defmacro parall
   "Executes the expressions in parallel, returning the results."
-  [& expr]
-  (map deref (doall (map #(future %) expr))))
+  [& exprs]
+  `(doall (pvalues ~@exprs)))

 (defn merge-options
   "Merges two maps by combining their values."


Increase scale up factor in killed_instance_test (#182)

--- waiter/integration/waiter/killed_instance_test.clj
+++ waiter/integration/waiter/killed_instance_test.clj
@@ -46,6 +46,7 @@
           extra-headers {:x-waiter-min-instances 0
                          :x-waiter-distribution-scheme "simple"
                          :x-waiter-scale-down-factor 0.9
+                         :x-waiter-scale-up-factor 0.9
                          :x-kitchen-delay-ms 5000
                          :x-waiter-name (rand-name)}
           request-fn (fn []


insights: add comment on advanced optimizations

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -18,6 +18,17 @@
             [frontend.models.build :as build])
   (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
                    [frontend.utils :refer [html defrender]]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                                                                         ;;
+;; Note that unexterned properties must be accessed with `aget` instead of ;;
+;; the `.-` or `..` shortcut notations.                                    ;;
+;;                                                                         ;;
+;; Google closure compiler with "advanced" optimizations will mangle       ;;
+;; unexterned field names.                                                 ;;
+;;                                                                         ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn add-queued-time [build]
   (let [queued-time (max (build/queued-time build) 0)]
@@ -78,6 +89,7 @@
         (.append "rect")
         (.attr #js {"width" square-size
                     "height" square-size
+                    ;; `aget` must be used here instead of direct field access.  See note in preamble.
                     "class" #(aget % "classname")
                     "transform"
                     (fn [item i]


Remove migrate down command :arrow_down:

--- src/metabase/db.clj
+++ src/metabase/db.clj
@@ -196,7 +196,6 @@

    *  `:up`            - Migrate up
    *  `:force`         - Force migrate up, ignoring locks and any DDL statements that fail.
-   *  `:down`          - Rollback *all* migrations
    *  `:down-one`      - Rollback a single migration
    *  `:print`         - Just print the SQL for running the migrations, don't actually run them.
    *  `:release-locks` - Manually release migration locks left by an earlier failed migration.
@@ -217,7 +216,6 @@
          (case direction
            :up            (migrate-up-if-needed conn liquibase)
            :force         (force-migrate-up-if-needed conn liquibase)
-           :down          (.rollback liquibase 10000 "")
            :down-one      (.rollback liquibase 1 "")
            :print         (println (migrations-sql liquibase))
            :release-locks (.forceReleaseLocks liquibase)))


added comments to clojure solution

added comments to clojure solution

--- solutions/day09/solution.clj
+++ solutions/day09/solution.clj
@@ -40,33 +40,36 @@
 (defn path->children
   [path distance-map cities]
   (->> cities
-       (filter (complement (set path)))
+       (filter (complement (set path))) ; remove any cities that are already on the path
        (map #(conj path %))
-       (map #(vector % (path->cost % distance-map cities)))
+       ; put cost alongside path for easy use with priority-map conj
+       (map #(vector % (path->cost % distance-map cities)))
        (reduce concat)))

-(defn a-star
+(defn A*
   [distance-map cities]
   (loop [q (apply pm/priority-map (path->children [] distance-map cities))
          best-cost nil]
     (if-let [[path cost] (peek q)]
       (if (and best-cost (< best-cost cost))
+        ; if the best path available on the q costs more than the best solution we've found so far, we're done
         best-cost
         (let [children (path->children path distance-map cities)
               q (pop q)]
           (if (empty? children)
-            (recur q cost)
+            (recur q cost) ; complete path - if we've gotten here, it's also the lowest-cost complete path
             (recur (apply assoc q children) best-cost)))))))

 (defn part1
   [distance-map cities]
-  (a-star distance-map cities))
+  (A* distance-map cities))

 (defn part2
   [distance-map cities]
+  ; invert the city-to-city distance map, effectively making A* maximize the cost
   (let [neg-distances (map #(* -1 %) (vals distance-map))
         neg-distance-map (zipmap (keys distance-map) neg-distances) ]
-    (* -1 (a-star neg-distance-map cities))))
+    (* -1 (A* neg-distance-map cities))))

 (println "part 1:" (part1 distance-map cities))
 (println "part 2:" (part2 distance-map cities))


more meaningful log messages

more meaningful log messages

--- src/tranjlator/bing.clj
+++ src/tranjlator/bing.clj
@@ -53,7 +53,7 @@
                    [?e :translation/sha ?trans-sha]
                    [(java.util.Arrays/equals ^bytes ?sha ^bytes ?org-sha)]]
                  (db conn) sha from to)]
-      (log/info "datomic query response:" res)
+      (log/info "Datomic query response:" res)
       (first res))))

 ;; Bing API
@@ -114,10 +114,10 @@
                       :server-sha (-> text sha-bytes bin->hex)}))
          (let [text-sha (hex->bin text-sha)]
            (if-let [[trans org-sha trans-sha :as resp] (<! (db-lookup-translation (:conn db) text-sha from to))]
-             (do (log/info "datomic translation:" resp)
+             (do (log/info "Datomic translation:" resp)
                  (>! result-chan  resp))
              (do
-               (log/info "gotta lookup")
+               (log/info "Querying Microsoft translation service..")
                (http/get "http://api.microsofttranslator.com/v2/Http.svc/Translate"
                          {:headers {"Authorization" (str "Bearer " (if (extends? impl/ReadPort (type access-token))
                                                                      (:token (<! access-token))


only watch existing files and directories fix #451 (#551)

--- sidecar/src/figwheel_sidecar/watching.clj
+++ sidecar/src/figwheel_sidecar/watching.clj
@@ -13,7 +13,8 @@

 (defn files-and-dirs [source-paths]
   (group-by #(if (.isDirectory %) :dirs :files)
-            (map io/file source-paths)))
+            (->> (map io/file source-paths)
+                 (filter #(.exists %)))))

 ;; relies on canonical strings
 (defn is-subdirectory [dir child]


Grid double and half modifiers.

Grid double and half modifiers.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -433,16 +433,40 @@
     om/IRenderState
     (render-state [_ state]
       (let [transition #(om/update-state! owner (fn [s] (merge s %)))
-            closer #(dom/span #js {:onClick (fn [] (transition {:state :init}))} %)]
+            closer #(dom/span #js {:onClick (fn [] (transition {:state :init}))} %)
+            double-width #(let [tracks (get cursor "tracks")
+                                doubled-tracks (map (fn [t]
+                                                      (let [beats (get t "beats")]
+                                                        (assoc t "beats"
+                                                               (take (* 2 (count beats))
+                                                                     (cycle beats)))))
+                                                    tracks)]
+                            (om/transact! cursor (fn [c] (assoc cursor "tracks" (clj->js doubled-tracks))))
+                            (go (>! set-state-ch id)))
+            half-width #(let [tracks (get cursor "tracks")
+                              halved-tracks (map (fn [t]
+                                                   (let [beats (get t "beats")]
+                                                     (assoc t "beats"
+                                                            (take (int (/ (count beats) 2)) beats))))
+                                                 tracks)]
+                          (print tracks)
+                          (print halved-tracks)
+                          (om/transact! cursor (fn [c] (assoc cursor "tracks" (clj->js halved-tracks))))
+                          (go (>! set-state-ch id)))]
         (condp = (:state state)
           :init (dom/span #js {:onClick #(transition {:state :open})}
                           "{..}")
           :open (dom/span nil
-                          (closer "{ ")
+                          (closer "{")
                           (dom/span nil
-                                    (dom/span nil "bpc: ")
+                                    (dom/span nil " bpc: ")
                                     (dom/span #js {:onClick #(transition {:state :editing-bpc})}
                                               (str (get cursor "bpc"))))
+                          (dom/span nil
+                                    (dom/span nil " width: ")
+                                    (dom/span #js {:onClick double-width} "+")
+                                    (dom/span nil "/")
+                                    (dom/span #js {:onClick half-width} "-"))
                           (dom/span nil " }"))
           :editing-bpc (dom/span nil
                                  (closer "{ ")


Added  function for parsing with clojure-csv and applying process to that

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -198,7 +198,24 @@
 ;;       (doall
 ;;         (process (csv/parse-csv in-file))))

-;;
+;; ## parse-and-process
+
+(defn parse-and-process
+  "This is a convenience function for reading a csv file using `clojure/data.csv` and passing it through process
+  with the given set of options (specified _last_ as kw_args). Note that `:parser-opts` can be specified and
+  will be passed along to `clojure-csv/parse-csv`"
+  [csv-readable & {:keys [parser-opts]
+                   :or   {parser-opts {}}
+                   :as   opts}]
+  (let [rest-options (dissoc opts :parser-opts)]
+    (process rest-options (impl/apply-kwargs csv/parse-csv csv-readable))))
+
+;; Now we can cut out an extra set of parentheses...
+;;
+;;     (with-open [in-file (io/reader "test/test.csv")]
+;;       (doall
+;;         (parse-and-process in-file)))
+

 (defn read-csv-file


Structure the code for better verification of an image during ls

--- src/obcc/dar/ls.clj
+++ src/obcc/dar/ls.clj
@@ -24,25 +24,25 @@

 (defn read-protobuf [t is] (->> is (fl/protobuf-seq t) first))

-(defn verify-compatibility [header] (let [compat (select-keys header [:magic :version])] (= compat CompatVersion)))
+(defn read-header [is] (read-protobuf Header is))
+(defn read-archive [is] (read-protobuf Archive is))

-(defn read-header [is]
-  (when-let [header (read-protobuf Header is)]
-    (when (verify-compatibility header)
-      header)))
+(defn verify-header [is]
+  (if-let [header (read-header is)]
+    (let [compat (select-keys header [:magic :version])]
+      (if-not (= compat CompatVersion)
+        (throw (Exception. (str "Incompatible header detected (expected: " CompatVersion " got: " compat ")")))))
+    (throw (Exception. (str "Failed to read archive header")))))

 (defn ls [file]
   (with-open [is (io/input-stream file)]
-    (if-let [header (read-header is)]
-      (let [archive (read-protobuf Archive is)
-            payload (->> archive :payload .newInput (fl/protobuf-load-stream Payload))]
+    (verify-header is)
+    (let [archive (read-archive is)
+          payload (->> archive :payload .newInput (fl/protobuf-load-stream Payload))]

-        (println (doric/table [{:name :size} {:name :sha1 :title "SHA1"} {:name :path}] (:entries payload)))
-        (println "Digital Signature:  none")
-        (println "Raw Data Size:     " (->> payload :entries (map :size) (reduce +)) "bytes")
-        (println "Archive Size:      " (.length file) "bytes")
-        (println "Compression Alg:   " (->> payload :compression :description))
-        (println "Chaincode SHA-256: " (sha256 file)))
-
-      ;; else
-      (throw (Exception. (str "Error: " file " does not appear to be a valid archive"))))))
+      (println (doric/table [{:name :size} {:name :sha1 :title "SHA1"} {:name :path}] (:entries payload)))
+      (println "Digital Signature:  none")
+      (println "Raw Data Size:     " (->> payload :entries (map :size) (reduce +)) "bytes")
+      (println "Archive Size:      " (.length file) "bytes")
+      (println "Compression Alg:   " (->> payload :compression :description))
+      (println "Chaincode SHA-256: " (sha256 file)))))


Exercise 2.17, 2.18

Exercise 2.17, 2.18

--- src/sicp/chapter2/2_1.clj
+++ src/sicp/chapter2/2_1.clj
@@ -1,4 +1,5 @@
-(ns sicp.chapter2.2-1)
+(ns sicp.chapter2.2-1
+  (:require [sicp.common.list :refer :all]))

 ;;;; 2.2  Hierarchical Data and the Closure Property

@@ -12,6 +13,11 @@

 (last-pair (list 23 72 149 34))

+(defn last-pair' [pair]
+  (if (nil? (cdr pair))
+    pair
+    (recur (cdr pair))))
+
 ;; Exercise 2.18
 (defn reverse' [coll]
   (letfn [(rev [coll acc]
@@ -22,6 +28,22 @@
     (rev coll [])))

 (reverse' (list 1 4 9 16 25))
+
+(defn reverse'' [l]
+  (letfn [(rev [l acc]
+            (if (nil? l)
+              acc
+              (recur (cdr l)
+                     (kons (car l) acc))))]
+    (rev l nil)))
+
+(defn reverse''' [l]
+  (loop [l l
+         acc nil]
+    (if (nil? l)
+      acc
+      (recur (cdr l)
+             (kons (car l) acc)))))

 ;; Exercise 2.19
 (def us-coins (list 50 25 10 5 1))


add ffilter

add ffilter

--- dada-core/src/main/clojure/org/dada/dsl.clj
+++ dada-core/src/main/clojure/org/dada/dsl.clj
@@ -623,6 +623,9 @@
 	       tgt-data-tuple))]))
   )

+(defn ffilter [key required-value]
+  (split key (fn [candidate-value] (if (= candidate-value required-value) (list candidate-value) '()))))
+
 ;; pivot fn must supply such a closed list of values to be used as
 ;; attribute metadata for output model....
 (defn pivot-metadata [#^Metadata src-metadata #^Collection primary-keys #^Collection pivot-values value-key]


set :config tab as default in case of errors

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -837,6 +837,7 @@
                                     :usage-queue
                                     :config)
                                   :commits)
+   (build-model/config-errors? build) :config
    ;; Otherwise, just use the first one.
    :else :tests))


Load skin with asset manager

Load skin with asset manager

--- src/play_clj/ui.clj
+++ src/play_clj/ui.clj
@@ -41,9 +41,10 @@

     (skin \"uiskin.json\")"
   [path & options]
-  `(u/calls! ^Skin (Skin. (if (string? ~path)
-                            (.internal ^Files (Gdx/files) ~path)
-                            ~path))
+  `(u/calls! ^Skin (or (u/load-asset ~path Skin)
+                       (Skin. (if (string? ~path)
+                                (.internal ^Files (Gdx/files) ~path)
+                                ~path)))
              ~@options))

 (defmacro skin!


Make morphs only draggable if flag is set.

--- src-cljs/cljs_workspace/om_draggable.cljs
+++ src-cljs/cljs_workspace/om_draggable.cljs
@@ -39,7 +39,7 @@
         [prev-cursor-x, prev-cursor-y] @prev-cursor-pos
         [delta-x, delta-y] [(- (.-clientX e) prev-cursor-x) (- (.-clientY e) prev-cursor-y)]
         [new-pos-x, new-pos-y] [(+ (old-pos :x) delta-x) (+ (old-pos :y) delta-y)]]
-    (when (= (@app :id) @clicked-morph)
+    (when (and (= (@app :id) @clicked-morph) (get-in @app [:morph :isDraggable]))
       (swap! prev-cursor-pos #(identity [(.-clientX e) (.-clientY e)]))
       (om/update! app [:morph :Position] {:x new-pos-x :y new-pos-y} :update))))


1st version of explaining why can't edit privacy

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -275,15 +275,31 @@
             invite-email (get-in app state/invite-email-path)
             doc-id (:document/id app)
             doc (doc-model/find-by-id @db doc-id)
-            private? (= :document.privacy/private (:document/privacy doc))]
+            private? (= :document.privacy/private (:document/privacy doc))
+            cant-edit-reason (cond (:team app)
+                                   nil
+
+                                   (not (contains? (get-in app [:cust :flags]) :flags/private-docs))
+                                   :no-private-docs-flag
+
+                                   (not (auth/owner? @db doc (get-in app [:cust])))
+                                   :not-creator)]
         (html
          [:div.menu-view
           (if private?
             (om/build private-sharing app)
             (om/build public-sharing app))

-          (when (and (contains? (get-in app [:cust :flags]) :flags/private-docs)
-                     (auth/owner? @db doc (get-in app [:cust])))
+          (case cant-edit-reason
+            :no-private-docs-flag
+            [:div.vein.make.stick
+             (common/icon (if private? :lock :globe))
+             [:a {:href "/pricing"}
+              "Start your trial to create private docs"]]
+            :not-creator
+            [:div.vein.make.stick
+             (common/icon (if private? :lock :globe))
+             "Only the creator can change privacy"]
             [:form.privacy-select.vein.make.stick
              [:input.privacy-radio
               {:type "radio"
@@ -291,9 +307,11 @@
                :id "privacy-public"
                :name "privacy"
                :checked (not private?)
-               :onChange #(cast! :document-privacy-changed
-                                 {:doc-id doc-id
-                                  :setting :document.privacy/public})}]
+               :onChange #(if cant-edit-reason
+                            (utils/stop-event %)
+                            (cast! :document-privacy-changed
+                                   {:doc-id doc-id
+                                    :setting :document.privacy/public}))}]
              [:label.privacy-label
               {:for "privacy-public"
                :role "button"}
@@ -305,9 +323,11 @@
                :id "privacy-private"
                :name "privacy"
                :checked private?
-               :onChange #(cast! :document-privacy-changed
-                                 {:doc-id doc-id
-                                  :setting :document.privacy/private})}]
+               :onChange #(if cant-edit-reason
+                            (utils/stop-event %)
+                            (cast! :document-privacy-changed
+                                   {:doc-id doc-id
+                                    :setting :document.privacy/private}))}]
              [:label.privacy-label
               {:for "privacy-private"
                :role "button"}


allow enabling of java.mail debug

allow enabling of java.mail debug

--- src/postal/smtp.clj
+++ src/postal/smtp.clj
@@ -45,7 +45,7 @@
          (catch Exception e
            {:code 99 :error (class e) :message (.getMessage e)}))))
   ([args & msgs]
-     (let [{:keys [host port user pass sender ssl]
+     (let [{:keys [host port user pass sender ssl debug]
             :or {host "localhost"}} args
             port (if (nil? port)
                    (if ssl 465 25)
@@ -54,5 +54,5 @@
             args (merge args {:port port
                               :proto proto})
             session (doto (Session/getInstance (make-props sender args))
-                      (.setDebug false))]
+                      (.setDebug (if debug true false)))]
        (smtp-send* session proto args msgs))))


Better history driven project fetching.

Better history driven project fetching.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -75,11 +75,86 @@
       (vector new-selected
               (map-replace template ids)))))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Slugs
+(defn slugify-programme [programme]
+  (assoc programme :slug (:name programme)))
+
+(defn slugify-project "Create a slug for projects in the UI"
+  [project]
+  (assoc project :slug (:name project)))
+
+(defn slugify-property
+  "Create a slug for a property in the UI"
+  [property]
+  (let [property_data (:property_data property)]
+    (assoc property
+      :slug
+      (apply str (str/join
+                  ", "
+                  (->> (vector (:property_code property)
+                               (:address_street_two property_data)
+                               (:address_code property_data)
+                               (:address_country property_data))
+                       (keep identity)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Data Fetchers
+(defn fetch-projects [programme-id data]
+  (om/update! data [:projects :programme_id] programme-id)
+  (om/update! data [:projects :fetching] :fetching)
+  (GET (str "/4/programmes/" programme-id "/projects/")
+       {:handler  (fn [x]
+                    (println "Fetching data for programme: " programme-id)
+                    (om/update! data [:projects :data] (mapv slugify-project x))
+                    (om/update! data [:projects :fetching] (if (empty? x) :no-data :has-data))
+                    (om/update! data [:projects :selected] nil))
+        :error-handler (fn [{:keys [status status-text]}]
+                         (om/update! data [:projects :fetching] :error)
+                         (om/update! data [:projects :error-status] status)
+                         (om/update! data [:projects :error-text] status-text))
+        :headers {"Accept" "application/edn"}
+        :response-format :text}))
+
 (defn history-loop [history-channel data]
   (go-loop []
-    (let [nav-event (<! history-channel)]
-      (println "Old Active Components: " (:active-components @data))
+    (let [nav-event (<! history-channel)
+          {:keys [programmes projects properties]} (-> nav-event :args :ids)
+          old-nav (:active-components @data)
+          old-programmes (:programmes old-nav)
+          old-projects (:projects old-nav)
+          old-properties (:properties old-nav)]
+      (println "Old Programmes: " old-programmes " Old Projects: " old-projects " Old Properties: " old-properties)
+      (println "New Programmes: " programmes " New Projects: " projects " New Properties: " properties)
       (println "New Active Components: " (-> nav-event :args :ids))
+
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;; Clear down
+      (when (and old-programmes
+                 (nil? programmes))
+        (println "Clearing projects.")
+        (om/update! data [:projects :data] []))
+
+      (when (and old-projects
+                 (nil? projects))
+        (println "Clearing properties.")
+        (om/update! data [:properties :data] []))
+
+      (when (and old-properties
+                 (nil? properties))
+        (println "Clearing devices, sensors and measurements.")
+        (om/update! data [:devices :data] [])
+        (om/update! data [:sensors :data] [])
+        (om/update! data [:measurements :data] []))
+
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;; Fetchers
+      (when (and programmes
+                 (not= programmes old-programmes))
+        (println "Setting selected programme to: " programmes)
+        (om/update! data [:programmes :selected] programmes)
+        (fetch-projects programmes data))
+
       (om/update! data :active-components (-> nav-event :args :ids)))
     (recur)))

@@ -172,9 +247,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; programmes
-(defn slugify-programme [programme]
-  (assoc programme :slug (:name programme)))
-
 (defn programmes-table [data owner]
   (reify
     om/IRender
@@ -235,10 +307,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; projects
-(defn slugify-project "Create a slug for projects in the UI"
-  [project]
-  (assoc project :slug (:name project)))
-
 (defmulti projects-table-html (fn [projects owner] (:fetching projects)))
 (defmethod projects-table-html :fetching [projects owner]
   (fetching-row projects))
@@ -284,39 +352,6 @@

 (defn projects-div [data owner]
   (reify
-    om/IDidUpdate
-    (did-update [_ prev-props prev-state]
-      (let [{:keys [programmes projects active-components]} data
-            new-programme_id (:programmes active-components)]
-
-        ;; handle selection in programme table
-        (when-not new-programme_id
-          (om/update! projects :data [])
-          (om/update! projects :selected nil))
-
-        ;; get the data if we have a new id
-        (if (and new-programme_id
-                 (not (= (:programme_id projects) new-programme_id)))
-          (do
-            (om/update! projects :fetching :fetching)
-            (GET (str "/4/programmes/" new-programme_id "/projects/")
-                 {:handler  (fn [x]
-                              ;; (println "Fetching projects for programme: " new-programme_id)
-                              (om/update! projects :data (mapv slugify-project x))
-                              (om/update! projects :fetching (if (empty? x) :no-data :has-data))
-                              (om/update! projects :selected nil))
-                  :error-handler (fn [{:keys [status status-text]}]
-                                   (om/update! projects :fetching :error)
-                                   (om/update! projects :error-status status)
-                                   (om/update! projects :error-text status-text))
-                  :headers {"Accept" "application/edn"}
-                  :response-format :text})))
-
-        ;; update our current id with the new one
-        (om/update! projects :programme_id new-programme_id)
-
-        ;; handle selection in projects table
-        (om/update! projects :selected (:projects active-components))))
     om/IRender
     (render [_]
       (let [{:keys [programmes projects active-components]} data
@@ -333,13 +368,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; properties
-(defn slugify-property
-  "Create a slug for a property in the UI"
-  [property]
-  (assoc property :slug (apply str (interpose ", " (->> (vector (:property_code property) (:address_street_two property))
-                                                        (keep identity)
-                                                        (remove empty?))))))
-
 (defmulti properties-table-html (fn [properties owner] (:fetching properties)))
 (defmethod properties-table-html :fetching [properties owner]
   (fetching-row properties))


Add the ability to access to the internal input stream.

--- src/potok/core.cljs
+++ src/potok/core.cljs
@@ -56,7 +56,8 @@
 ;; An abstraction used for send data to the store.

 (defprotocol Store
-  (^:private -push [_ event] "Push event into the stream."))
+  (^:private -push [_ event] "Push event into the stream.")
+  (^:private -input-stream [_] "Returns the internal input stream/subject."))

 ;; --- Predicates

@@ -147,6 +148,11 @@
            (when @stoped? (throw (ex-info "store already terminated" {})))
            (rx/push! input-sb event))

+         (-input-stream [_]
+           (->> input-sb
+                (rx/map identity)
+                (rx/share)))
+
          Object
          (close [_]
            (vreset! stoped? true)
@@ -166,3 +172,11 @@
   ([store event & more]
    {:pre [(satisfies? Store store)]}
    (run! (partial -push store) (cons event more))))
+
+(defn input-stream
+  "Returns the internal input stream of the store. Should
+  be used by third party integration that want use store
+  as event bus not only with defined events."
+  [store]
+  {:pre [(satisfies? Store store)]}
+  (-input-stream store))


Hide the summary if there is nothing to summarise.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -515,15 +515,17 @@
             series-1-count (count series-1)
             series-1-mean (if (not= 0 series-1-count) (/ series-1-sum series-1-count) "NA")]
         (html
-         [:div.row#summary-stats
-          [:div {:class "col-md-3"}
-           (bs/panel "Minimum" (str (.toFixed (js/Number. series-1-min) 3) " " unit))]
-          [:div {:class "col-md-3"}
-           (bs/panel "Maximum" (str (.toFixed (js/Number. series-1-max) 3) " " unit))]
-          [:div {:class "col-md-3"}
-           (bs/panel "Average (mean)" (str (.toFixed (js/Number. series-1-mean) 3) " " unit))]
-          [:div {:class "col-md-3"}
-           (bs/panel "Range" (str (.toFixed (js/Number. (- series-1-max series-1-min)) 3) " " unit))]])))))
+         (if (seq measurements)
+           [:div.row#summary-stats
+            [:div {:class "col-md-3"}
+             (bs/panel "Minimum" (str (.toFixed (js/Number. series-1-min) 3) " " unit))]
+            [:div {:class "col-md-3"}
+             (bs/panel "Maximum" (str (.toFixed (js/Number. series-1-max) 3) " " unit))]
+            [:div {:class "col-md-3"}
+             (bs/panel "Average (mean)" (str (.toFixed (js/Number. series-1-mean) 3) " " unit))]
+            [:div {:class "col-md-3"}
+             (bs/panel "Range" (str (.toFixed (js/Number. (- series-1-max series-1-min)) 3) " " unit))]]
+           [:div.row#summary-stats [:div.col-md-12]]))))))

 (defn sensors-div [data owner]
   (reify


CMR-2815 temporary commit

CMR-2815 temporary commit

--- access-control-app/src/cmr/access_control/services/acl_validation.clj
+++ access-control-app/src/cmr/access_control/services/acl_validation.clj
@@ -161,8 +161,7 @@
 (defn permissions-granted-by-provider-to-user
   "Returns true if acl grants permission on sids"
   [sids acl]
-  (let [group-permissions (:group-permissions (read-string (:metadata acl)))
-        _ (proto-repl.saved-values/save 4)]
+  (let [group-permissions (:group-permissions (read-string (:metadata acl)))]
     (for [x sids
           y group-permissions
           :when (= x (if (contains? y :group-id) (:group-id y) (:user-type y)))]
@@ -180,10 +179,7 @@
                                                           :items
                                                           (map :concept_id))))
         provider-id (:provider-id acl)
-        provider (mdb1/find-latest-concept context
-                                           {:provider-id provider-id}
-                                           :acl)
-        _ (proto-repl.saved-values/save 1)]
+        provider-catalog-item-acls (search-util/search-for-acls context {:display-name (format "Provider - %s - CATALOG_ITEM_ACL" provider-id)})]
     (when-not (contains? (set (flatten (permissions-granted-by-provider-to-user sids provider))) "create")
       {key-path [(format "User [%s] does not have permission to create catalog item targeting provider-id [%s]"
                           user provider-id)]})))


Inject a 'blank card' for when there isn't a card to show

--- src-cljs/kixi/hecuba/main_om.cljs
+++ src-cljs/kixi/hecuba/main_om.cljs
@@ -33,31 +33,22 @@
                            (get-in data model-path)
                            {:key :hecuba/name}))))))))

-#_(defn card [data owner]
-  (om/component
-      (println "Rendering card: " (:title data) (:visible data))
-      (dom/div #js {:style #js {"display" (if (:visible data) "block" "none")}}
-           (dom/h1 nil (:title data)))))
-
 (defn about-card [data owner]
   (om/component
       (dom/p nil "I'm the About card")))
+
+(defn blank-card [data owner]
+  (om/component
+      (dom/p nil "This page is unintentionally left blank")))

 (defn card-container [cards]
   (fn [data owner]
     (om/component
         (dom/div nil
-             (when-let [card (get cards (-> data :card-container :selected))]
-               (println "Building a found card:" (-> data :card-container :selected))
+             (if-let [card (get cards (-> data :card-container :selected))]
                (om/build card data)
+               (om/build blank-card data))))))

-               )
-             #_(om/build-all card
-                 (map (fn [x]
-                        (if (= (:name x) (-> data :card-container :selected))
-                          (assoc x :visible true) x))
-                      (-> data :card-container :cards))
-                 {:key :name})))))

 (def app-model
   (atom {:messages []
@@ -81,8 +72,12 @@
          :projects []
          :properties []}))

-(defn ^:export change-card [card]
-  (swap! app-model assoc-in [:card-container :selected] card))
+(defn ^:export handle-left-nav [menu-item]
+  ;; Currently we implement a one-to-one correspondence between the
+  ;; left-hand-menu and the card container, but in due course 'Project'
+  ;; and 'Properties' will cause a scroll to a location under the
+  ;; 'Programmes' card
+  (swap! app-model assoc-in [:card-container :selected] menu-item))

 (defn ^:export change []
   (.log js/console "Hello Malcolm!")
@@ -90,7 +85,7 @@
   )

 ;; Add navigation.
-(om/root app-model (nav/nav change-card) (.getElementById js/document "hecuba-nav"))
+(om/root app-model (nav/nav handle-left-nav) (.getElementById js/document "hecuba-nav"))

 ;; Attach projects to a table component at hecuba-projects
 #_(om/root app-model (create-table [:projects]


i can get the dom window dimensions

i can get the dom window dimensions

--- src/runner/dom.cljs
+++ src/runner/dom.cljs
@@ -3,12 +3,8 @@
             [om.dom :as dom :include-macros true]))

-(defn player-style
-  "construct a style string from a js array. e.g position = #js [0, 9.8]"
-  [player]
-  #js {:position "absolute"
-       :bottom (js/Math.round (* 80 (:y player)))
-       :left (js/Math.round (* 80 (:x player)))})
+;; in-game utils
+;; ----------------------------------------------------------------------------

 (defn player-coordinates [player owner]
   (reify
@@ -17,23 +13,6 @@
             (dom/div #js {:className "coordinates"}
                      (dom/p nil (str "x: " (:x player)))
                      (dom/p nil (str "y: " (:y player)))))))
-
-(defn player-view [player owner]
-  (reify
-    om/IRender
-    (render [_]
-            (dom/div #js {:style (player-style player)
-                          :className "player"} "player"))))
-
-
-(defn game-view [state owner]
-  (reify
-    om/IRender
-    (render [_]
-            (dom/div nil
-                     (om/build player-coordinates (:player state))
-                     (om/build player-view (:player state))))))
-

 (defn controller-keys
   "construct a string that specifies the state of the controller keys"
@@ -49,3 +28,44 @@
     (render [_]
             (dom/div nil
                      (dom/p nil (controller-keys (:controller state)))))))
+
+;; screen coordinates
+;; ----------------------------------------------------------------------------
+
+(def screen-width (fn [_] js/window.innerWidth))
+(def screen-height (fn [_] js/window.innerHeight))
+
+
+
+;; player view
+;; ----------------------------------------------------------------------------
+
+(defn player-style
+  "construct a style string from a js array. e.g position = #js [0, 9.8]"
+  [player]
+  #js {:position "absolute"
+       :bottom (js/Math.round (* 80 (:y player)))
+       :left (js/Math.round (* 80 (:x player)))})
+
+
+(defn player-view [player owner]
+  (reify
+    om/IRender
+    (render [_]
+            (dom/div #js {:style (player-style player)
+                          :className "player"} "player"))))
+
+
+;; game view/wrapper
+;; ----------------------------------------------------------------------------
+
+(defn game-view [state owner]
+  (reify
+    om/IRender
+    (render [_]
+            (dom/div nil
+                     (om/build player-coordinates (:player state))
+                     (om/build player-view (:player state))))))
+
+
+


extracting links from google results

extracting links from google results

--- src/scrape/core.clj
+++ src/scrape/core.clj
@@ -16,9 +16,16 @@
                                                (.setCapability "phantomjs.cli.args" (into-array String ["--ignore-ssl-errors=true"
                                                                                "--webdriver-loglevel=WARN"]))))}))

-(defonce phantom (create-driver))
+;;(defonce phantom (create-driver))

-(set-driver! phantom)
+(set-driver! (init-driver
+               {:webdriver
+                 (PhantomJSDriver. (doto (DesiredCapabilities.)
+                                     (.setCapability "phantomjs.page.settings.userAgent", "Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/36.0.1985.143 Safari/537.36")
+                                     (.setCapability "phantomjs.page.customHeaders.Accept-Language" "en-US")
+                                     (.setCapability "phantomjs.page.customHeaders.Connection" "keep-alive")
+                                     (.setCapability "phantomjs.cli.args" (into-array String ["--ignore-ssl-errors=true"
+                                                                                "--webdriver-loglevel=WARN"]))))}))

 (defn as-rdfa
   ([q]
@@ -27,3 +34,11 @@
    (rdfa.parser/get-rdfa
      (StringReader.
        (html driver q)) (current-url driver) :html)))
+
+
+(defn google-results [tag]
+  (let [res (e/html-resource (StringReader. (html tag)))
+        links (e/select-nodes* res [:li.g :h3.r :a])]
+    (into [] (for [{{href :href} :attrs :as node} links] {:name (e/text node)
+                                                         :href href}))))
+


extend coercion capabilities of json bodies (#129)

--- src/yada/request_body.clj
+++ src/yada/request_body.clj
@@ -159,7 +159,7 @@
       (with-400-maybe)))

 (defmethod default-matcher "application/json" [_]
-  sc/json-coercion-matcher)
+  (rsc/coercer :json))

 (defmethod process-request-body "application/json"
   [& args]


Fix default fonts

Fix default fonts

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -997,9 +997,8 @@
          default fg-color [255 255 255]
          default bg-color [0 0 0]
          on-key-fn        nil
-         windows-font     "Courier New"
-         else-font        "Monospaced"
-         font-size        16
+         windows-font     (TTFFont. "Courier New" 16)
+         else-font        (TTFFONT. "Monospaced" 16)
          antialias        true
          icon-paths       nil
          fx-shader        {:name "passthrough.fs"}}}]


delaney.clj: Clojure invariant for D-symbol matches Java version

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -63,7 +63,7 @@
     ((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] (->> todo (filter (comp seq second)) first)]
+             [i todo-for-i] (first (filter (comp seq second) todo))]
          (cond
            (seq todo-for-i)
            (let [D (first todo-for-i)
@@ -86,12 +86,12 @@
         ipairs (zipmap indices (rest indices))
         step (fn step [xs emap n]
                (when (seq xs)
-                 (let [[[_ i D] & xs] xs
-                       E (or (emap D) n)
+                 (let [[[Di i D] & xs] xs
+                       [Ei E] (sort [(emap Di) (or (emap D) n)])
                        new? (= E n)
                        emap (if new? (assoc emap D n) emap)
                        n (if new? (inc n) n)
-                       head (if (= i :root) [-1] [(imap i) (emap (s ds i D))])
+                       head (if (= i :root) [-1] [(imap i) Ei])
                        tail (if new? (map (fn [[i j]] (v ds i j D)) ipairs) [])]
                    (concat head [E] tail (step xs emap n)))))]
     (step traversal {} 1)))


delaney.clj: small change in (invariant) implementation

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -154,7 +154,10 @@
   ([ds]
     (when (pos? (size ds))
       (assert (connected? ds) "Symbol must be connected")
-      (apply lexicographically-smallest
+      (reduce (fn [inv p]
+                (if (or (nil? inv) (neg? (compare-lexicographically p inv)))
+                  p
+                  inv))
              (for [D (elements ds)] (invariant ds D))))))

 (defn walk [ds D & idxs]


Another day, another tweak to continue scraping

Now curiositymsl.com wants a php session id cookie in the request
headers, so a php session id cookie it shall have.

--- src/mars_ogler/scrape.clj
+++ src/mars_ogler/scrape.clj
@@ -110,9 +110,10 @@
   [i]
   (let [page (:body (http/post
                       "http://curiositymsl.com/localphp/loadmore.php"
-                      {:headers {"X-Requested-With" "XMLHttpRequest"}
+                      {:headers {"Cookie" "PHPSESSID=3v55ibi7c0l25836c2chenpmo1"
+                                 "X-Requested-With" "XMLHttpRequest"}
                        :form-params {:q "", :z "UTC", :s "etreleased",
-                                     :o "desc", :n 100
+                                     :l "all" :o "desc", :n 100
                                      :start (* (dec i) 100)}}))
         tmp-file "/tmp/ogle-scrape"]
     (spit tmp-file page)


no need for by-hand gensymming... Or am I missing something?

--- src/midje/ideas/facts.clj
+++ src/midje/ideas/facts.clj
@@ -100,11 +100,10 @@
 ;; `tabular` expansions use `seq-zip`.

 (defn wrap-with-creation-time-fact-recording [function-form]
-  (let [function-symbol (gensym "fact-function-")]
-    `((fn [~function-symbol]
-        (record-fact-existence ~function-symbol)
-        ~function-symbol)
-      ~function-form)))
+  `((fn [fact-function#]
+      (record-fact-existence fact-function#)
+      fact-function#)
+    ~function-form))

 (defn run-after-creation [function-form]
   `(~function-form))


Clean up protoc invocation logic

Clean up protoc invocation logic

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

--- src/obcc/build/golang.clj
+++ src/obcc/build/golang.clj
@@ -99,6 +99,16 @@
     (.add template "queries" queries)
     (.render template)))

+(defn protoc [proto]
+  (let [{:keys [exit err]} (shell/sh "protoc" "--go_out=./" (str proto))]
+    (cond
+
+      (= exit 0)
+      true
+
+      :else
+      (throw (Exception. (str "protoc error:" err))))))
+
 ;;-----------------------------------------------------------------
 ;; compile - generates golang shim code and writes it to
 ;; the default location in the build area
@@ -115,4 +125,4 @@
       (.write output shim))

     ;; generate protobuf output
-    (shell/sh "protoc" "--go_out=./" (str protofile))))
+    (protoc protofile)))


emoji regexp update

emoji regexp update

--- src-clj/acha/achievement.clj
+++ src-clj/acha/achievement.clj
@@ -269,7 +269,7 @@
 (def cool-kid
   [:emoji
    (fn [{:keys [message author time]}]
-     (when (re-find #"[\uD83C-\uDBFF\uDC00-\uDFFF]+" message)
+     (when (re-find #"[\u20a0-\u32ff\ud83c\udc00-\ud83d\udeff\udbb9\udce5-\udbb9\udcee]" message)
          {:username author
           :time time}))])


integrating the login-form into the login view

--- src-cljs/bitfondue/core.cljs
+++ src-cljs/bitfondue/core.cljs
@@ -83,7 +83,9 @@
      [:input.form-control {:type "email" :id "usernameInput" :placeholder "Your username please."}]]]])

 (defn login []
-  [layout [:h1 "Login"]])
+  [layout [:div.row
+           [:h1 "Login"]
+           login-form]])

 (defn register []
   [layout [:h1 "Register"]])


Fix use of incorrect argument in call to scroll-to-node

--- src-cljs/frontend/utils.cljs
+++ src-cljs/frontend/utils.cljs
@@ -273,7 +273,7 @@
   "Scrolls to the element with given id, if node exists"
   [id]
   (when-let [node (dom/getElement id)]
-    (scroll-to-node! id)))
+    (scroll-to-node! node)))

 (defn scroll-to-selector!
   "Scrolls to the first element matching the selector, if node exists"


flatten level

flatten level

--- clojure/src/dnd/showScreen.cljs
+++ clojure/src/dnd/showScreen.cljs
@@ -2,19 +2,18 @@
   (:require [cljs.nodejs :as nodejs]))

 (defn draw-block [term block]
-  (let [{:keys [x y solid inhabitants] } block
-        hasPlayer (boolean (seq inhabitants))
-        color   (if hasPlayer 0 3)
-        bgcolor (if solid 2 10)
-        char    (if hasPlayer "@" ".")]
-    (.color256    term color)
+
+  (let [{:keys [x y solid inhabitants color] } block
+        has-inhabitant (boolean (seq inhabitants))
+        fgcolor (or (:color (first inhabitants)) 0)
+        bgcolor (or color (if solid 0 10))
+        char    (if has-inhabitant
+                  (:char (first inhabitants))
+                  (if solid "▒" " "))]
+    (.color256    term fgcolor)
     (.bgColor256  term bgcolor)
     (.moveTo      term x y char)))

-(defn doall* [s] (dorun (tree-seq seq? seq s)) s)
+(defn show-screen [term level]
+  (dorun (map #(draw-block term %) (flatten level))))

-(defn show-screen [term level]
-  (doall* (map (fn [row]
-                (map #(draw-block term %) row))
-              level)))
-


fix test

fix test

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -307,19 +307,23 @@
   (is (not (empty? (parse "I turned the radio on"))))
   (is (not (empty? (parse "I turned off the radio"))))
   (is (not (empty? (parse "I turned the radio off"))))
-  (let [generated (generate {:synsem {:sem {:pred :turn-on
-                                            :tense :present
-                                            :obj {:mod '()
-                                                  :number :sing
-                                                  :spec {:def :def
-                                                         :of {:pred nil}}}
-                                            :subj {:pred :lei}}
-                                      :cat :verb}})]
-    (is (= "she turns the radio on"
-           (morph generated))
-        (= "she turns on the radio"
-           (morph generated)))))
-
-
-
-
+  (let [generated (morph (generate {:synsem {:sem {:pred :turn-on
+                                                   :tense :present
+                                                   :obj {:mod '()
+                                                         :number :sing
+                                                         :pred :radio
+                                                         :spec {:def :def
+                                                                :of {:pred nil}}}
+                                                   :subj {:pred :lei}}
+                                             :cat :verb}}))]
+    (is (or (= "she turns the radio on"
+                generated)
+            (= "she turns on the radio"
+               generated)))))
+
+
+
+
+
+
+


Allow model position to be set without assoc

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -77,11 +77,12 @@
   (draw-entity! [{:keys [^ModelInstance object x y z]}
                  {:keys [^ModelBatch renderer ^Environment attributes]}
                  _]
-    (let [^Matrix4 m (. object transform)
-          x (float (or x 0))
-          y (float (or y 0))
-          z (float (or z 0))]
-      (.setTranslation m x y z))
+    (when (or x y z)
+      (let [^Matrix4 m (. object transform)
+            x (float (or x 0))
+            y (float (or y 0))
+            z (float (or z 0))]
+        (.setTranslation m x y z)))
     (.render renderer object attributes)))

 (defrecord ShapeEntity [object] Entity


add icons to date/time inputs

add icons to date/time inputs

--- src/cljs/re_form/inputs/date_input_impl.cljs
+++ src/cljs/re_form/inputs/date_input_impl.cljs
@@ -2,17 +2,33 @@
   (:require [reagent.core :as r]
             [goog.string :as gstring]
             [goog.string.format]
+            [garden.units :as u]
             [re-form.inputs.calendar-impl :refer [re-calendar]]
             [clojure.string :as str]))
 (defn date-input-style
-  [{:keys [h h2 h3 selection-bg-color hover-bg-color border]}]
-  [:.date-input
-   {:position :relative}
-   [:.calendar-dropdown
-    {:position :absolute
-     :z-index 1
+  [{:keys [w h h2 h3 selection-bg-color gray-color hover-bg-color border]}]
+  [:*
+   [:.dropdown-input
+    [:.calendar-dropdown
+     {:position :absolute
+      :z-index 1
+      :border border
+      :background-color :white}]]
+   [:.date-input
+    {:position :relative
      :border border
-     :background-color :white}]])
+     :display :flex
+     :align-items :center
+     :border-radius (u/px 2)}
+    [:i.material-icons {:display :inline-block
+                        :font-size (u/px h2)
+                        :vertical-align :middle
+                        :color gray-color
+                        :padding [[0 (u/px w)]]}]
+    [:input.re-input {:display :inline-block
+                      :border :none
+                      :padding-left 0
+                      :width (u/px- 244 h2 (* 3 w))}]]])

 (def formats
   {
@@ -96,14 +112,15 @@

       :reagent-render
       (fn [{:keys [with-dropdown value on-change errors on-blur err-classes] :as props}]
-        [:div.date-input
-         {:on-blur #(my-on-blur % on-blur)}
-         [:input.re-input (merge (dissoc props :errors :with-dropdown :format)
-                        {:type "text"
-                         :placeholder (:placeholder fmt-obj)
-                         :on-focus #(swap! state assoc :dropdown-visible true)
-                         :on-change #(my-onchange % on-change)
-                         :value (:value @state)})]
+        [:div.dropdown-input
+         [:div.date-input {:on-blur #(my-on-blur % on-blur)}
+          [:i.material-icons "today"]
+          [:input.re-input (merge (dissoc props :errors :with-dropdown :format)
+                                  {:type "text"
+                                   :placeholder (:placeholder fmt-obj)
+                                   :on-focus #(swap! state assoc :dropdown-visible true)
+                                   :on-change #(my-onchange % on-change)
+                                   :value (:value @state)})]]
          (when (and with-dropdown (:dropdown-visible @state))
            [:div.calendar-dropdown
             [re-calendar
@@ -150,11 +167,11 @@
       (fn [{:keys [value on-change errors on-blur err-classes] :as props}]
         [:div
          [:input.re-input (merge (dissoc props :errors)
-                        {:type "text"
-                         :placeholder (:placeholder fmt-obj)
-                         :on-blur #(my-on-blur % on-blur)
-                         :on-change #(my-onchange % on-change)
-                         :value (:value @state)})]
+                                 {:type "text"
+                                  :placeholder (:placeholder fmt-obj)
+                                  :on-blur #(my-on-blur % on-blur)
+                                  :on-change #(my-onchange % on-change)
+                                  :value (:value @state)})]
          [:div {:class (apply str (interpose "." err-classes))}
           (when-let [local-errors (:errors @state)]
             (str/join "\n" (conj errors local-errors)))]])})))
@@ -208,12 +225,14 @@
       :reagent-render
       (fn [{:keys [value on-change errors on-blur err-classes] :as props}]
         [:div
-         [:input.re-input (merge (dissoc props :errors)
-                        {:type "text"
-                         :placeholder (get placeholder fmt)
-                         :on-blur #(my-on-blur % on-blur)
-                         :on-change #(my-onchange % on-change)
-                         :value (:value @state)})]
+         [:div.date-input
+          [:i.material-icons "schedule"]
+          [:input.re-input (merge (dissoc props :errors)
+                                  {:type "text"
+                                   :placeholder (get placeholder fmt)
+                                   :on-blur #(my-on-blur % on-blur)
+                                   :on-change #(my-onchange % on-change)
+                                   :value (:value @state)})]]
          [:div {:class (apply str (interpose "." err-classes))}
           (when-let [local-errors (:errors @state)]
             (str/join "\n" (conj errors local-errors)))]])})))