Add markdown parsing

Add markdown parsing

--- src/markiki/views.cljs
+++ src/markiki/views.cljs
@@ -3,6 +3,7 @@
             [re-frame.core :refer [subscribe dispatch]]
             [cljs-time.format :as f]
             [cljs-time.coerce :as c]
+            [markdown.core :refer [md->html]]
             [clojure.string :refer [blank?]]))

@@ -39,7 +40,7 @@
      [:h1 title]
      [:h4 "Last modified: " (f/unparse (f/formatter "EEEE dd MMM yyyy HH:mm:ss")
                                        (c/from-long last-modified))]
-     [:div text]])) ;; TODO: translate markdown
+     [:div {:dangerouslySetInnerHTML {:__html (md->html text)}}]]))

 (defn markiki-app []
   (let [loading?      (subscribe [:loading?])


put index.html in browser, so server and extension can share code

--- src/mediakeys/core.clj
+++ src/mediakeys/core.clj
@@ -32,5 +32,5 @@
             (onMessage [c j]
                 (println (str "yo mesage " j))
                 (next! @incoming-sub j))))
-    (.add (StaticFileHandler. "."))
-    (.start)))+    (.add (StaticFileHandler. "browser/"))
+    (.start)))


create service handler

create service handler

--- src/cljs/swarmpit/component/service/create.cljs
+++ src/cljs/swarmpit/component/service/create.cljs
@@ -5,6 +5,7 @@
             [swarmpit.component.service.form-ports :as ports]
             [swarmpit.component.service.form-variables :as variables]
             [swarmpit.component.message :as message]
+            [swarmpit.component.progress :as progress]
             [rum.core :as rum]
             [ajax.core :refer [POST]]))

@@ -44,11 +45,26 @@
           item)))
     steps))

-(defn- state
+(defn- create-service-handler
   []
-  (-> @settings/state
-      (assoc :ports @ports/state)
-      (assoc :variables @variables/state)))
+  (POST "/services"
+        {:format  :json
+         :params  (-> @settings/state
+                      (assoc :ports @ports/state)
+                      (assoc :variables @variables/state))
+         :finally (progress/mount!)
+         :handler
+                  (fn [response]
+                    (let [id (get response "ID")]
+                      (progress/unmount!)
+                      (router/dispatch! (str "/#/services/" id))
+                      (message/mount!
+                        (str "Service " id " has been created."))))
+         :error-handler
+                  (fn [{:keys [status status-text]}]
+                    (progress/unmount!)
+                    (message/mount!
+                      (str "Service creation failed. Status: " status " Reason: " status-text)))}))

 (rum/defc form < rum/reactive []
   (let [index (rum/react step-index)]
@@ -79,19 +95,7 @@
          (material/raised-button
            #js {:label      "Create"
                 :primary    true
-                :onTouchTap (fn []
-                              (POST "/services"
-                                    {:format :json
-                                     :params (state)
-                                     :handler
-                                             (fn [response]
-                                               (router/dispatch! "/#/services")
-                                               (message/mount!
-                                                 (str "Service " (get "ID" response) " has been created.")))
-                                     :error-handler
-                                             (fn [{:keys [status status-text]}]
-                                               (message/mount!
-                                                 (str "Service creation failed. Reason: " status-text)))}))}))]]]))
+                :onTouchTap (create-service-handler)}))]]]))

 (defn- init-settings-state
   []


impl/input? tells you whether or not a signal is an input signal

--- src/cljx/jamesmacaulay/zelkova/impl/signal.cljx
+++ src/cljx/jamesmacaulay/zelkova/impl/signal.cljx
@@ -91,6 +91,7 @@
 ; compiling graphs:

 (defprotocol SignalProtocol
+  (input? [s])
   (signal-deps [s] "returns the set of \"parent\" signals on which this signal depends")
   (parents-map [s])
   (kids-map [s])
@@ -166,6 +167,7 @@
 (defrecord SignalDefinition
   [init-fn sources relayed-event-topic msg-fn deps event-sources]
   SignalProtocol
+  (input? [_] (some #{:events} sources))
   (signal-deps [_]
     (into #{}
           (filter signal?)


Thinner pulse bars

Thinner pulse bars

--- src/metabase/pulse.clj
+++ src/metabase/pulse.clj
@@ -183,7 +183,7 @@
                 (-> row (nth col-idx) (format-cell col) h)])
             (if bar-column
               [:td {:style (str bar-td-style "width: 99%;")}
-                [:div {:style (str "background-color: " color-purple "; height: 20px; width: " (float (* 100 (/ (bar-column row) max-value))) "%")} " "]])])
+                [:div {:style (str "background-color: " color-purple "; max-height: 10px; height: 10px; border-radius: 2px; width: " (float (* 100 (/ (bar-column row) max-value))) "%")} " "]])])
           rows)]]))

 (defn render-truncation-warning


Fix fetch body passing

Fix fetch body passing

--- src/com/wsscode/pathom/diplomat/http/fetch.cljs
+++ src/com/wsscode/pathom/diplomat/http/fetch.cljs
@@ -45,7 +45,7 @@
   (s/assert ::http/request req)
   (go-catch
     (let [{::http/keys [accept]} (normalize-as req)
-          response (<!p (js/fetch url (build-request-map req)))]
+          response (<!p (js/fetch url (clj->js (build-request-map req))))]
       {::http/status (gobj/get response "status")
        ::http/body   (case accept
                        ::http/json (js->clj (<!p (.json response)) :keywordize-keys true)


wip - nearly there, still need to refactor and test

--- src/mirthsync/apis.clj
+++ src/mirthsync/apis.clj
@@ -405,21 +405,28 @@
                   :script
                   [cz/up cz/up cz/up :transformer cz/up :sourceConnector])]

-   [(partial name-script-sequence "destinationConnector-filter-step-")
+   [(fn [loc] (let [destname (apply cdzx/xml1-> loc (flatten [(repeat 4 cz/up) :name cdzx/text]))]
+                (str "destinationConnector" (when-not (cs/blank? destname)
+                                              (str "-" destname))
+                     "-" (name-script-sequence "filter-step-" loc))))
     #(cdzx/xml1-> %
                   (this-tag= :com.mirth.connect.plugins.javascriptrule.JavaScriptRule)
                   :script
-                  [cz/up cz/up cz/up :filter cz/up :destinationConnectors])]
+                  [cz/up cz/up cz/up :filter cz/up :connector cz/up :destinationConnectors])]

    [(fn [loc] (let [destname (apply cdzx/xml1-> loc (flatten [(repeat 4 cz/up) :name cdzx/text]))]
-                (str "destinationConnector-" destname "-" (name-script-sequence "transformer-step-" loc))))
+                (str "destinationConnector" (when-not (cs/blank? destname)
+                                              (str "-" destname))
+                     "-" (name-script-sequence "transformer-step-" loc))))
     #(cdzx/xml1-> %
                   (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
                   :script
                   [cz/up cz/up cz/up :transformer cz/up :connector cz/up :destinationConnectors])]

    [(fn [loc] (let [destname (apply cdzx/xml1-> loc (flatten [(repeat 4 cz/up) :name cdzx/text]))]
-                (str "destinationConnector-" destname "-" (name-script-sequence "responseTransformer-step-" loc))))
+                (str "destinationConnector" (when-not (cs/blank? destname)
+                                              (str "-" destname))
+                     "-" (name-script-sequence "responseTransformer-step-" loc))))
     #(cdzx/xml1-> %
                   (this-tag= :com.mirth.connect.plugins.javascriptstep.JavaScriptStep)
                   :script


Add fn for pulling off replies

Add fn for pulling off replies

--- src/myshelf/worker.clj
+++ src/myshelf/worker.clj
@@ -84,12 +84,24 @@
       (process-command channel user-handle cmd args)
       (request-goodreads-access channel user-handle))))

+(defn declare-reply-queue
+  [channel]
+  (lq/declare channel reply-queue {:auto-delete false}))
+
+(defn get-reply
+  "Pull a single message off of the reply queue"
+  [channel]
+  (declare-reply-queue channel)
+  (when-let [reply (lb/get channel reply-queue)]
+    (-> reply
+        second
+        (String. "UTF-8")
+        (json/parse-string true))))
+
 (defn -main [& [key secret]]
   (let [conn (lc/connect)
         channel (lch/open conn)]
     (compare-and-set! goodreads-key nil key)
     (compare-and-set! goodreads-secret nil secret)
-    (lq/declare channel worker-queue
-                {:auto-delete false})
-    (lcs/subscribe channel worker-queue
-                   handle-message {:auto-ack true})))
+    (lq/declare channel worker-queue {:auto-delete false})
+    (lcs/subscribe channel worker-queue handle-message {:auto-ack true})))


Update test-data

Update test-data

--- src/devcards/discuss/components/references.cljs
+++ src/devcards/discuss/components/references.cljs
@@ -21,6 +21,8 @@
       :text
       "Sie argumentieren, dass E-Autos das autonome Fahren vorantreiben, weil Tesla mutig bestehende Techniken einsetzt und zeigt was sie können",
       :author {:uid 1, :nickname "anonymous"},
+      :conclusion "E-Autos das autonome Fahren vorantreiben",
+      :premise "Tesla mutig bestehende Techniken einsetzt und zeigt was sie können",
       :issue
       {:title "Elektroautos",
        :slug "elektroautos",
@@ -31,9 +33,10 @@
        :language "de",
        :date "2017-08-19 11:25:09+00:00"}}
      {:uid 42,
-      :text
-      "Irgendein anderes Argument aus einer anderen Diskussion",
+      :text "Irgendein anderes Argument aus einer anderen Diskussion",
       :author {:uid 3, :nickname "Christian"},
+      :conclusion "meine conclusion",
+      :premise "mein generierter premisegroup-text",
       :issue
       {:title "Anderes Thema",
        :slug nil,
@@ -47,9 +50,6 @@
      :url "/api/elektroautos/justify/68/agree",
      :text "Tesla mutig bestehende Techniken einsetzt und zeigt was sie können"}}])

-(def sample-reference-with-single-argument
-  {:argument (first (:arguments (first sample-reference-usages)))})
-

 ;; -----------------------------------------------------------------------------

@@ -61,11 +61,6 @@

 (defcard sample-passage
   "<p id='discuss-text'>Currently, the city council discusses to close the University Park, because of its high running expenses of about $100.000 per year. But apparently there is an anonymous investor ensuring to pay the running costs for at least the next five years. Thanks to this anonymous person, the city does not loose a beautiful park, but this again fires up the discussion about possible savings for the future. </p>")
-
-(defcard-om-next single-reference-usage
-  ref/ReferenceUsageForSingleArgumentView
-  (om/reconciler {:state sample-reference-with-single-argument
-                  :parser (om/parser {:read parser/read})}))

 (defcard-om-next reference-usages-for-all-arguments
   ref/ReferenceUsagesForArgumentsView


import now uses get-or-create for sport and user tables

--- src/ontrail/import.clj
+++ src/ontrail/import.clj
@@ -12,6 +12,7 @@
   (html/html-resource (java.io.FileReader. filename)))

 (defn get-exercises [imported-html]
+  "First one is a heading, so choose rest of TR-elements."
   (rest (html/select imported-html [:tr])))

 (defn is-ex? [ex-html]
@@ -28,12 +29,22 @@
     (.getTime (java.util.Date. (- (nth date-array 2) 1900)
                                (+ 1 (second date-array))
                                (first date-array) 12 0))))
-(defn get-uid [name] 1)
+(defn get-or-create-login-id [login-id]
+    (let [_login-id (mc/find-one "onuser" {:_id login-id})]
+      (if (= nil _login-id) (mc/insert "onuser" {:_id login-id}))
+      login-id))

 (defn get-timestamp [exercise]
   (convert-to-timestamp (html/text (nth exercise 0))))

 (defn get-heading [exercise] (html/text (nth exercise 1)))
+
+(defn get-or-create-sport [exercise]
+  "XXX: not thread safe!??"
+  (let [sport-id (html/text (nth exercise 2))
+        _sport-id (mc/find-one "onsport" {:_id sport-id})]
+    (if (= nil _sport-id) (mc/insert "onsport" {:_id sport-id}))
+    sport-id))

 (defn get-report [exercise]
   "Emits the html in report and joins all strings in it."
@@ -61,11 +72,11 @@
 (defn get-tags [exercise]
   (html/text (nth exercise 8)))

-(defn insert [uid exercise]
+(defn insert [login-id exercise]
   (mc/insert "exercise"
                   {:date (get-timestamp exercise),
-                   :user uid,
-                   :sport 1,
+                   :user login-id,
+                   :sport (get-or-create-sport exercise),
                    :duration (get-duration exercise),
                    :distance (get-distance exercise),
                    :avghr (get-avghr exercise),
@@ -75,10 +86,17 @@
                    :tags (get-tags exercise)
                    }))

+(defn import-user-and-file [login-id filename]
+  (let [login-id (get-or-create-login-id login-id)
+        imported-html (import-html filename)]
+    (try
+      (doall
+       (map #(if (is-ex? %)
+               (insert login-id (get-exercise %))
+               -1)
+            (get-exercises imported-html)))
+      (catch Exception e (prn e)))))
+
 (defn -main [& args]
   "First arg is an username, and the second export filename."
-  (let [uid (get-uid (first args))
-        imported-html (import-html (second args))]
-    (try
-      (doall (map #(if (is-ex? %) (insert uid (get-exercise %))) (get-exercises imported-html)))
-      (catch Exception e (prn e)))))
+  (import-user-and-file (first args) (second args)))


copyright

copyright

--- src/aws/validations.clj
+++ src/aws/validations.clj
@@ -1,3 +1,14 @@
+(comment
+   Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+   Licensed under the Apache License,
+   Version 2.0  (the "License") you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.)
+
 (ns aws.validations
   "AWS based validations"
   (:use
@@ -33,6 +44,5 @@
   :key-name [v/required cv/str?]
   )

-
 (defn provider-validation [{:keys [aws] :as spec}]
   (cv/validate!! ::invalid-aws aws aws-provider))


s/INFO/DEBUG/

s/INFO/DEBUG/

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -54,9 +54,9 @@
                                                   :truncate-children truncate-children)))]
       (if expression
         (do
-          (log/info (str "generate: generated "
-                         (morph-ps expression)
-                         " for spec:" (strip-refs spec)))
+          (log/debug (str "generate: generated "
+                          (morph-ps expression)
+                          " for spec:" (strip-refs spec)))
           (log/trace (str "generate: generated "
                           "'" (morph expression) "';"
                           " expr spec: "


comments

comments

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -93,6 +93,9 @@
                :comps (map #(comp-path-to-complements bolt % model depth max-depth) paths)})))

      ;; 4. Create the cartesian product of all the possible complements at all paths within each bolt.
+     ;; B1:P1_1:C1_1 P1_2:C1_1,...,P1_n:C1_1
+     ;; B1:P1_2:C1_1 P2_2:C1_1,...,P1_n:C1_2
+     ;; ..
      (mapcat (fn [{bolt :bolt comps :comps paths :paths}]
                ;; TODO: further flatten this into the overall ->> pipeline
                (map (fn [each-path-through-trellis]
@@ -101,7 +104,7 @@
                        :trellis each-path-through-trellis})
                     (lazy-seq (apply combo/cartesian-product comps)))))

-     ;; 5. For each bold, create tree parts for each path-complement pair of the bolt.
+     ;; 5. For each bolt, create tree parts for each path-complement pair of the bolt.
      (map (fn [{bolt :bolt paths :paths trellis :trellis}]
             (cons bolt
                   ;; TODO: further flatten this into the overall ->> pipeline


back to 6 for max-total-depth

back to 6 for max-total-depth

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -10,7 +10,7 @@

 ;; during generation, will not decend deeper than this when creating a tree:
 ;; TODO: should also be possible to override per-language.
-(def ^:const max-total-depth 2)
+(def ^:const max-total-depth 6)

 ;; TODO support setting max-generated-complements to :unlimited
 (def ^:const max-generated-complements 20000)


remove done TODO

remove done TODO

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -256,9 +256,6 @@
                                           (spec-info spec)
                                           )]
                             (log/warn message)
-                            ;; TODO: add optional exception-throwing if
-                            ;; "could generate neither phrasal nor lexical complements for bolt.." is
-                            ;; reached.
                             (if error-if-no-complements (exception message)))

                           lexemes-before-phrases


add documentation

add documentation

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -43,6 +43,7 @@
                    :or {max-total-depth max-total-depth
                         lexicon nil
                         truncate-children true}}]
+  "Returns a single expression generated by the given language model, constrained by the given spec."
   (let [language-model (if (future? language-model) @language-model language-model)
         lexicon (if lexicon lexicon (:lexicon language-model))
         morph (:morph language-model)


move first arg of (merge) higher for more clarity hopefully

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -182,15 +182,14 @@
   ;; using pmap rather than map improves performance about 40% in some cases.
   (pmap (fn [lb]
           (merge
+           {[]
+            (filter not-fail? [lb])}
            (let [comp-paths (find-comp-paths lb)]
              (zipmap comp-paths
                      (map (fn [path]
                             (filter not-fail? (comp-path-to-complements lb path model depth max-depth)))
-                          comp-paths)))
-           {[]
-            (filter not-fail? [lb])}))
-        (let [bolts
-              (lightning-bolts model spec depth max-depth)]
+                          comp-paths)))))
+        (let [bolts (lightning-bolts model spec depth max-depth)]
           (if (empty? bolts)
             (do
               (log/debug (str "bolts-with-comps:" depth "/" max-depth ":" (strip-refs spec) ": no bolts found."))


more dereferencing of futures

more dereferencing of futures

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -19,7 +19,7 @@
 (defn fo-ps [expression]
   (morph/fo-ps1 expression))

-(def lexicon (:lexicon medium))
+(def lexicon (:lexicon @medium))
 (def infinitives
   (filter (fn [k]
             (let [vals (get lexicon k)]
@@ -66,7 +66,7 @@

 (defn analyze
   ([surface-form]
-   (analyze surface-form (:lexicon medium)))
+   (analyze surface-form (:lexicon @medium)))
   ([surface-form lexicon]
    (morph/analyze surface-form lexicon)))

@@ -86,7 +86,8 @@
             result))))

 (defn lightning-bolts [spec]
-  (generate/lightning-bolts (:grammar medium) (:lexicon medium) spec 0 (:index medium) nil (:morph medium)))
+  (let [medium @medium]
+    (generate/lightning-bolts (:grammar medium) (:lexicon medium) spec 0 (:index medium) nil (:morph medium))))

 (def tokenizer #"[ '\n,’».]")

@@ -127,7 +128,8 @@
      (parse input medium)))

   ([input model]
-   (let [input (preprocess input)]
+   (let [model (if (future? model) @model model)
+         input (preprocess input)]
      (cond (string? input)
            (map (fn [tokenization]
                   {:tokens tokenization


Workaround for problems with java.classpath/classpath on java 9

--- joplin.core/src/joplin/core.clj
+++ joplin.core/src/joplin/core.clj
@@ -11,7 +11,10 @@
              [core]
              [protocols]
              [repl]
-             [strategy]]))
+             [strategy]])
+  (:import
+   [java.io File]
+   [java.util.jar JarFile]))

 ;; ==========================================================================
 ;; methods implemented by migrator/seed targets
@@ -70,6 +73,17 @@
        (interpose delimiter)
        (apply str)))

+(defn- classpath-directories []
+  (filter #(and
+            (instance? File %)
+            (.isDirectory ^File %))
+          (classpath/system-classpath)))
+
+(defn- classpath-jarfiles []
+  (->> (classpath/system-classpath)
+       (filter classpath/jar-file?)
+       (map #(java.util.jar.JarFile. ^java.io.File %))))
+
 (defn- get-files
   "Get migrations files given a folder path.
 Will try to locate files on the local filesystem, folder on the classpath
@@ -77,28 +91,28 @@
   [path]
   (let [local-folder          (io/file path)
         classpath-folder-name (drop-first-part path "/")
-        folder-on-classpath   (->> (classpath/classpath-directories)
-                                   (map #(str (.getPath %) "/" classpath-folder-name))
+        folder-on-classpath   (->> (classpath-directories)
+                                   (map #(str (.getPath ^File %) "/" classpath-folder-name))
                                    (map io/file)
-                                   (filter #(.isDirectory %))
+                                   (filter #(.isDirectory ^File %))
                                    first)]

     (cond
      ;; If it's a local folder just read the file from there
      (.isDirectory local-folder)
      (->> (.listFiles local-folder)
-          (map #(vector % (.getName %))))
+          (map #(vector % (.getName ^File %))))

      ;; If it's a folder on the classpath use that
      folder-on-classpath
-     (->> (.listFiles folder-on-classpath)
-          (map #(vector % (.getName %))))
+     (->> (.listFiles ^File folder-on-classpath)
+          (map #(vector % (.getName ^File %))))

      ;; Try finding this path inside a jar on the classpath
      :else
-     (->> (classpath/classpath-jarfiles)
+     (->> (classpath-jarfiles)
           (mapcat classpath/filenames-in-jar)
-          (filter #(.startsWith % classpath-folder-name))
+          (filter #(.startsWith ^String % classpath-folder-name))
           (map #(vector (io/resource %) (.getName (io/file %))))))))

 (defn- get-migration-namespaces


lazytest2.clj: modify some docs & make open/close private

--- src/main/clojure/com/stuartsierra/lazytest2.clj
+++ src/main/clojure/com/stuartsierra/lazytest2.clj
@@ -2,7 +2,7 @@

 (deftype Context [parents before after])

-(defn open-context
+(defn- open-context
   "Opens context c, and all its parents, unless it is already active."
   [active c]
   (let [active (reduce open-context active (:parents c))
@@ -11,7 +11,7 @@
       (assoc active c (or (active c) (apply f states)))
       active)))

-(defn close-context
+(defn- close-context
   "Closes context c and removes it from active."
   [active c]
   (let [states (map active (:parents c))]
@@ -155,7 +155,7 @@
                  nxt))
         `(SimpleContainer ~r)))))

-(defn attributes
+(defn- attributes
   "Reads optional name symbol and doc string from args,
   returns [m a] where m is a map containing keys
   [:name :doc :ns :file :line] and a is remaining arguments."
@@ -167,7 +167,7 @@
         args (if (string? (first args)) (next args) args)]
     [m args]))

-(defn options
+(defn- options
   "Reads keyword-value pairs from args, returns [m a] where m is a map
   of keyword/value options and a is remaining arguments."
   [args]
@@ -180,8 +180,8 @@
   "Creates a test container.
   decl   => name? docstring? option* child*

-  name   => a symbol, will def a Var if provided.
-  child  => 'should' or 'given' or nested 'testing'
+  name  => a symbol, will def a Var if provided.
+  child => 'should' or 'given' or nested 'testing'.

   options => keyword/value pairs, recognized keys are:
     :contexts => vector of contexts to run only once for this container.
@@ -198,4 +198,3 @@
                     `(SimpleContainer ~children '~m nil))]
        ~(when (:name m) `(intern *ns* '~(:name m) ~csym))
        ~csym)))
-


Corrected route that I modified when testing

--- src/prop_shop/core.clj
+++ src/prop_shop/core.clj
@@ -8,7 +8,7 @@

 (defroutes main-routes
-  (GET "/" [] "Wow")
+  (GET "/" [] (response/redirect "main.htm"))
   (route/not-found "
Not Found!
"))

 (defn app


figwheel.main: make connection idempotent

--- figwheel-repl/src/figwheel/repl.cljc
+++ figwheel-repl/src/figwheel/repl.cljc
@@ -566,14 +566,20 @@
           (.setScheme "http")
           str))))

-(defn connect [& [connect-url']]
+(defn connect* [connect-url']
   (patch-goog-base)
   (let [url (switch-to-http? (string/trim (or connect-url' connect-url)))]
     (cond
       (gstring/startsWith url "ws")   (ws-connect url)
       (gstring/startsWith url "http") (http-connect url))))

-))
+(defn connect [& [connect-url']]
+  (defonce connected
+    (do (connect* connect-url') true))))
+
+)
+
+;; end :cljs

 #?(:clj (do


added management of atom terminals

added management of atom terminals

--- src/paredit/parser.clj
+++ src/paredit/parser.clj
@@ -87,8 +87,9 @@
 	            continue? (continue?-fn text offset line col parents parser-state accumulated-state)]
   	      (if (or (not continue?) (= :eof parser-state))
   	        (make-result-fn text offset line col parents parser-state accumulated-state)
-  	        (let [c (.charAt text offset)] ; c: current char
-  	          (condp = (-> parents peek :type)
+  	        (let [c (.charAt text offset)
+  	              parent-type (-> parents peek :type)] ; c: current char
+  	          (condp = parent-type
   	            \"
                   (cond
                     (= \newline c)
@@ -157,27 +158,29 @@
                   (*opening-brackets* c)
                     (recur
                       (inc offset) line (inc col)
-                      (conj parents {:type c :offset offset :line line :col col})
+                      (conj (if (= \a parent-type) (pop parents) parents) {:type c :offset offset :line line :col col})
                        accumulated-state)
                   (*closing-brackets* c)
                     (recur
                       (inc offset) line (inc col)
-                      (pop parents)
+                      (pop (if (= \a parent-type) (pop parents) parents))
                        accumulated-state)
-                  (= \return c)
-                    (recur (inc offset) line col parents accumulated-state) ; we do not increment the column
-                  (= \newline c)
-                    (recur (inc offset) (inc line) (int 0) parents accumulated-state)
+                  #_(= \return c)
+                    #_(recur (inc offset) line col parents accumulated-state) ; we do not increment the column
+                  #_(= \newline c)
+                    #_(recur (inc offset) (inc line) (int 0) parents accumulated-state)
                   (= \" c)
-                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col }) accumulated-state)
+                    (recur (inc offset) line (inc col) (conj (if (= \a parent-type) (pop parents) parents) {:type c :offset offset :line line :col col }) accumulated-state)
                   (= \; c)
-                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) accumulated-state)
+                    (recur (inc offset) line (inc col) (conj (if (= \a parent-type) (pop parents) parents) {:type c :offset offset :line line :col col}) accumulated-state)
                   (= \\ c)
-                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) accumulated-state)
+                    (recur (inc offset) line (inc col) (conj (if (= \a parent-type) (pop parents) parents) {:type c :offset offset :line line :col col}) accumulated-state)
                   (*spaces* c)
-                    (recur offset line col (conj parents {:type c :offset offset :line line :col col}) accumulated-state)
+                    (recur offset line col (conj (if (= \a parent-type) (pop parents) parents) {:type \space :offset offset :line line :col col}) accumulated-state)
                   :else
-                    (recur (inc offset) line (inc col) parents accumulated-state))
+                    (recur (inc offset) line (inc col)
+                      (if (= \a parent-type) parents (conj parents {:type \a :offset offset :line line :col col}))
+                      accumulated-state)) ; \a comme atom

                   #_(cond   ; leaved as a template if new cases have to be handled
                     (*opening-brackets* c)
@@ -187,6 +190,8 @@
                     (= \" c)
                     (= \; c)
                     (= \\ c)
+                    (= \space c)
+                    (= \c c)
                     :else
                       (recur (inc offset) line (inc col) parents accumulated-state))
                       )))))))


removed reflection warnings. Now 'parsing' core.clj takes 250ms on my computer

--- src/paredit/parser.clj
+++ src/paredit/parser.clj
@@ -1,5 +1,7 @@
 (ns paredit.parser
 	(:use clojure.test))
+
+(set! *warn-on-reflection* true)

 (def *brackets* {\( \) \{ \} \[ \]})
 (def *opening-brackets* (set (keys *brackets*)))
@@ -14,7 +16,7 @@
 	"TODO: currently the parser assumes a well formed document ...
 	 TODO: make the parser restartable at a given offset given a state ...
 	 TODO: make the parser fully incremental (via chunks of any possible size ...)"
-	[text stop-offset]
+	[#^String text stop-offset]
   (loop [{ :keys [parents offset line col] :as state} { :parents [{:type nil :offset 0 :line 0 :col 0}] :offset 0 :line 0 :col 0}]
       (if (>= offset stop-offset)
         state
@@ -85,10 +87,9 @@
               (recur (assoc state :offset (inc offset) :col (inc col))))))))

 (defn parse-core []
-  (time
-    (let [s (slurp "/home/lpetit/projects/clojure/src/clj/clojure/core.clj")]
-      (parse s (.length s))
-      (.length s))))
+    (let [#^String s (slurp "/home/lpetit/projects/clojure/src/clj/clojure/core.clj")]
+      (time (parse s (.length s)))
+      (.length s)))

 #_(deftest test-format-code
   (testing "parens combinatorics"


show trial end in team info

show trial end in team info

--- src/pc/views/admin.clj
+++ src/pc/views/admin.clj
@@ -547,7 +547,10 @@
       [:tr
        [:td "Plan url"]
        [:td (let [url (urls/team-plan team)]
-              [:a {:href url} url])]]]
+              [:a {:href url} url])]]
+      [:tr
+       [:td "Trial end"]
+       [:td (:plan/trial-end (:team/plan team))]]]
      (interesting team-docs))))

 (defn upload-files []


Try for better syntax colouring in API docs

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -33,6 +33,7 @@

   Usage:

+      #!clj
       (dispatch [:order \"pizza\" {:supreme 2 :meatlovers 1 :veg 1}])
   "
   {:api-docs/heading "Dispatching Events"}
@@ -60,6 +61,7 @@

   Usage:

+      #!clj
       (dispatch-sync [:sing :falsetto \"piano accordion\"])
   "
   {:api-docs/heading "Dispatching Events"}


Disable liberator debugging decorator.

Disable liberator debugging decorator.

--- src/clj/medusa/core.clj
+++ src/clj/medusa/core.clj
@@ -42,7 +42,7 @@

 (def handler
   (-> app
-      (wrap-trace :header :ui)
+      #_(wrap-trace :header :ui)
       (friend/authenticate {:credential-fn persona/credential-fn
                             :workflows [(partial persona/workflow "/login")]})))


Adapt blue for use with p5js

Adapt blue for use with p5js

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -819,7 +819,7 @@
   "Extracts the blue value from a color, scaled to match current color-mode.
   Returns a float."
   [color]
-  (.blue (current-graphics) (unchecked-int color)))
+  (.blue (current-graphics) color))

 (defn
   ^{:requires-bindings true


move string? predicate up so core fns can use it. optimize the cases where we handle JS strings and array cases directly. Disable JS native hash table lookup where it makes sense. goog.getUid -> goog/getUid, goog.isArray -> goog/isArray so we emit direct JS calls.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -370,7 +370,11 @@

 ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;

-(declare array-seq prim-seq string? keyword?)
+(declare array-seq prim-seq keyword? IndexedSeq)
+
+(defn ^boolean string? [x]
+  (and ^boolean (goog/isString x)
+    (not (identical? (.charAt x 0) \uFDD0))))

 (defn ^seq seq
   "Returns a seq on the collection. If the collection is
@@ -379,12 +383,14 @@
   [coll]
   (when-not (nil? coll)
     (cond
-      (satisfies? ISeqable coll)
+      (satisfies? ISeqable coll false)
       (-seq coll)
-
-      (or ^boolean (goog.isArray coll)
-        (string? coll))
-      (prim-seq coll 0)
+
+      ^boolean (goog/isArray coll)
+      (IndexedSeq. coll 0)
+
+      (string? coll)
+      (IndexedSeq. coll 0)

       :else (throw (js/Error. (str coll "is not ISeqable"))))))

@@ -393,7 +399,7 @@
   argument. If coll is nil, returns nil."
   [coll]
   (when-not (nil? coll)
-    (if (satisfies? ISeq coll)
+    (if (satisfies? ISeq coll false)
       (-first coll)
       (let [s (seq coll)]
         (when-not (nil? s)
@@ -404,7 +410,7 @@
   argument."
   [coll]
   (if-not (nil? coll)
-    (if (satisfies? ISeq coll)
+    (if (satisfies? ISeq coll false)
       (-rest coll)
       (let [s (seq coll)]
         (if-not (nil? s)
@@ -417,7 +423,7 @@
   argument.  If there are no more items, returns nil"
   [coll]
   (when-not (nil? coll)
-    (if (satisfies? INext coll)
+    (if (satisfies? INext coll false)
       (-next coll)
       (seq (rest coll)))))

@@ -505,7 +511,7 @@
 (extend-type default
   IHash
   (-hash [o]
-    (goog.getUid o)))
+    (goog/getUid o)))

 ;;this is primitive because & emits call to array-seq
 (defn inc
@@ -809,11 +815,14 @@
   ([coll n]
      (when-not (nil? coll)
        (cond
-         (satisfies? IIndexed coll)
+         (satisfies? IIndexed coll false)
          (-nth coll (.floor js/Math n))

-         (or ^boolean (goog.isArray coll)
-           (string? coll))
+         ^boolean (goog/isArray coll)
+         (when (< n (.-length coll))
+           (aget coll n))
+
+         (string? coll)
          (when (< n (.-length coll))
            (aget coll n))

@@ -822,11 +831,15 @@
   ([coll n not-found]
      (if-not (nil? coll)
        (cond
-         (satisfies? IIndexed coll)
+         (satisfies? IIndexed coll false)
          (-nth coll (.floor js/Math n) not-found)

-         (or ^boolean (goog.isArray coll)
-           (string? coll))
+         ^boolean (goog/isArray coll)
+         (if (< n (.-length coll))
+           (aget coll n)
+           not-found)
+
+         (string? coll)
          (if (< n (.-length coll))
            (aget coll n)
            not-found)
@@ -840,11 +853,14 @@
   ([o k]
     (when-not (nil? o)
       (cond
-        (satisfies? ILookup o)
+        (satisfies? ILookup o false)
         (-lookup o k)

-        (or ^boolean (goog.isArray o)
-          (string? o))
+        ^boolean (goog/isArray o)
+        (when (< k (.-length o))
+          (aget o k))
+
+        (string? o)
         (when (< k (.-length o))
           (aget o k))

@@ -852,11 +868,15 @@
   ([o k not-found]
     (if-not (nil? o)
       (cond
-        (satisfies? ILookup o)
+        (satisfies? ILookup o false)
         (-lookup o k not-found)

-        (or ^boolean (goog.isArray o)
-          (string? o))
+        ^boolean (goog/isArray o)
+        (if (< k (.-length o))
+          (aget o k)
+          not-found)
+
+        (string? o)
         (if (< k (.-length o))
           (aget o k)
           not-found)
@@ -1076,10 +1096,6 @@

 (defn ^boolean boolean [x]
   (if x true false))
-
-(defn ^boolean string? [x]
-  (and ^boolean (goog/isString x)
-    (not (identical? (.charAt x 0) \uFDD0))))

 (defn ^boolean keyword? [x]
   (and ^boolean (goog/isString x)
@@ -1150,12 +1166,18 @@
   [x y]
   (cond
    (identical? x y) 0
+
    (nil? x) -1
+
    (nil? y) 1
-   (identical? (type x) (type y)) (if (satisfies? IComparable x)
-                                    (-compare x y)
-                                    (garray/defaultCompare x y))
-   :else (throw (js/Error. "compare on non-nil objects of different types"))))
+
+   (identical? (type x) (type y))
+   (if (satisfies? IComparable x false)
+     (-compare x y)
+     (garray/defaultCompare x y))
+
+   :else
+   (throw (js/Error. "compare on non-nil objects of different types"))))

 (defn ^:private compare-indexed
   "Compare indexed collection."
@@ -1248,22 +1270,26 @@
   items, returns val and f is not called."
   ([f coll]
      (cond
-       (satisfies? IReduce coll)
+       (satisfies? IReduce coll false)
        (-reduce coll f)

-       (or ^boolean (goog.isArray coll)
-         (string? coll))
+       ^boolean (goog/isArray coll)
        (array-reduce coll f)

+       (string? coll)
+       (array-reduce coll f)
+
        :else
        (seq-reduce f coll)))
   ([f val coll]
      (cond
-       (satisfies? IReduce coll)
+       (satisfies? IReduce coll false)
        (-reduce coll f val)

-       (or ^boolean (goog.isArray coll)
-           (string? coll))
+       ^boolean (goog/isArray coll)
+       (array-reduce coll f val)
+
+       (string? coll)
        (array-reduce coll f val)

        :else
@@ -1894,7 +1920,7 @@
   "Returns a new seq where x is the first element and seq is the rest."
   [x coll]
   (if (or (nil? coll)
-          (satisfies? ISeq coll))
+          (satisfies? ISeq coll false))
     (Cons. nil x coll nil)
     (Cons. nil x (seq coll) nil)))

@@ -2097,7 +2123,7 @@
   (-chunked-rest s))

 (defn chunk-next [s]
-  (if (satisfies? IChunkedNext s)
+  (if (satisfies? IChunkedNext s false)
     (-chunked-next s)
     (seq (-chunked-rest s))))

@@ -2822,7 +2848,7 @@
   from-coll conjoined."
   [to from]
   (if-not (nil? to)
-    (if (satisfies? IEditableCollection to)
+    (if (satisfies? IEditableCollection to false)
       (persistent! (reduce -conj! (transient to) from))
       (reduce -conj to from))
     (reduce conj () from)))
@@ -5841,7 +5867,7 @@
 (defn name
   "Returns the name String of a string, symbol or keyword."
   [x]
-  (if (satisfies? INamed x)
+  (if (satisfies? INamed x false)
     (-name x)
     (cond
       (string? x) x
@@ -5855,7 +5881,7 @@
 (defn namespace
   "Returns the namespace String of a symbol or keyword, or nil if not present."
   [x]
-  (if (satisfies? INamed x)
+  (if (satisfies? INamed x false)
     (-namespace x)
     (if (keyword? x)
       (let [i (.lastIndexOf x "/" (- (alength x) 2))]
@@ -6237,7 +6263,7 @@
               (.cljs$lang$ctorPrWriter obj obj writer opts)

               ; Use the new, more efficient, IPrintWithWriter interface when possible.
-              (satisfies? IPrintWithWriter obj)
+              (satisfies? IPrintWithWriter obj false)
               (-pr-writer obj writer opts)

               (or (identical? (type obj) js/Boolean) (number? obj))
@@ -6506,7 +6532,7 @@
     (set! (.-watches this) (dissoc watches key)))

   IHash
-  (-hash [this] (goog.getUid this)))
+  (-hash [this] (goog/getUid this)))

 (defn atom
   "Creates and returns an Atom with an initial value of x and zero or
@@ -6737,7 +6763,7 @@
                   (coll? x)
                   (into (empty x) (map thisfn x))

-                  (goog.isArray x)
+                  (goog/isArray x)
                   (vec (map thisfn x))

                   (identical? (type x) js/Object)
@@ -7036,7 +7062,7 @@
   (-dispatch [mf args] (do-dispatch mf dispatch-fn args))

   IHash
-  (-hash [this] (goog.getUid this)))
+  (-hash [this] (goog/getUid this)))

 (set! cljs.core.MultiFn.prototype.call
       (fn [_ & args]


Uncomment IEmptyableCollection

Uncomment IEmptyableCollection

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -32,8 +32,8 @@
 (defprotocol ICounted
   (-count [coll] "constant time count"))

-#_(defprotocol IEmptyableCollection
-    (-empty [coll]))
+(defprotocol IEmptyableCollection
+  (-empty [coll]))

 (defprotocol ICollection
   (-conj [coll o]))
@@ -693,8 +693,8 @@
   ICollection
   (-conj [coll o] (cons o coll))

-; IEmptyableCollection
-; (iempty [coll] coll)
+  IEmptyableCollection
+  (-iempty [coll] coll)

   ISequential
   IEquiv
@@ -744,8 +744,8 @@
   ICollection
   (-conj [coll o] (List. meta o coll (inc count)))

-; IEmptyableCollection
-; (iempty [coll] coll)
+  IEmptyableCollection
+  (-iempty [coll] coll)

   ISequential
   IEquiv
@@ -781,8 +781,8 @@
   ICollection
   (-conj [coll o] (List. meta o nil 1))

-; IEmptyableCollection
-; (iempty [coll] coll)
+  IEmptyableCollection
+  (-iempty [coll] coll)

   ISequential
   IEquiv
@@ -819,8 +819,8 @@
   ICollection
   (-conj [coll o] (Cons. nil o coll))

-; IEmptyableCollection
-; (iempty [coll] List.EMPTY)
+  IEmptyableCollection
+  (-iempty [coll] (EmptyList. nil))

   ISequential
   IEquiv
@@ -1026,8 +1026,8 @@
       (.push new-array o)
       (Vector. meta new-array)))

-; IEmptyableCollection
-; (iempty [coll] coll)
+  IEmptyableCollection
+  (-iempty [coll] coll)

   ISequential
   IEquiv
@@ -1125,8 +1125,8 @@
   ICollection
   (-conj [coll entry] (-assoc coll (-nth entry 0) (-nth entry 1)))

-; IEmptyableCollection
-; (iempty [coll] coll)
+  IEmptyableCollection
+  (-iempty [coll] coll)

   IEquiv
   (-equiv [coll other] (equiv-map coll other))
@@ -1195,8 +1195,8 @@
   ICollection
   (-conj [coll entry] (-assoc coll (-nth entry 0) (-nth entry 1)))

-; IEmptyableCollection
-; (iempty [coll] coll)
+  IEmptyableCollection
+  (-iempty [coll] coll)

   IEquiv
   (-equiv [coll other] (equiv-map coll other))


status: put back initial nil

status: put back initial nil

--- src/cljs/type/core.cljs
+++ src/cljs/type/core.cljs
@@ -11,7 +11,7 @@
 ;; -------------------------
 ;; App state

-(defonce app (atom {:status :ended :score 0}))
+(defonce app (atom {:status nil :score 0}))

 (defonce first-interval 2000)
 (defonce speed-inc -10)
@@ -116,10 +116,11 @@

 (defn home-page []
   [:div
-   [timer-bar
-    (:timestamp @app)
-    (:status @app)
-    (get-interval)]
+   (when (:status @app)
+     [timer-bar
+      (:timestamp @app)
+      (:status @app)
+      (get-interval)])
    [:div.container
     [:span.logo.left "TYPE LETTER"]
     [:span.instructions-and-link.left


Add support for Date & Time functions.

Add support for Date & Time functions.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -1352,7 +1352,6 @@
   ([x y] (.curveVertex (current-graphics) (float x) (float y)))
   ([x y z] (.curveVertex (current-graphics) (float x) (float y) (float z))))

-#+clj
 (defn
   ^{:requires-bindings false
     :processing-name "day()"
@@ -1362,7 +1361,8 @@
   day
   "Get the current day of the month (1 through 31)."
   []
-  (PApplet/day))
+  #+clj (PApplet/day)
+  #+cljs (.day (current-applet)))

 (defn
   ^{:requires-bindings false
@@ -1919,7 +1919,6 @@
                     hint-type)]
     (.hint (current-graphics) (int hint-type))))

-#+clj
 (defn
   ^{:requires-bindings false
     :processing-name "hour()"
@@ -1929,7 +1928,8 @@
   hour
   "Returns the current hour as a value from 0 - 23."
   []
-  (PApplet/hour))
+  #+clj (PApplet/hour)
+  #+cljs (.hour (current-applet)))

 (defn
   ^{:requires-bindings true
@@ -2356,7 +2356,6 @@
   []
   (.millis (current-applet)))

-#+clj
 (defn
   ^{:requires-bindings false
     :processing-name "minute()"
@@ -2366,7 +2365,8 @@
   minute
   "Returns the current minute as a value from 0 - 59"
   []
-  (PApplet/minute))
+  #+clj (PApplet/minute)
+  #+cljs (.minute (current-applet)))

 (defn
   ^{:requires-bindings true
@@ -2413,7 +2413,6 @@
   [x y z]
   (.modelZ (current-graphics) (float x) (float y) (float z)))

-#+clj
 (defn
   ^{:requires-bindings false
     :processing-name "month()"
@@ -2423,7 +2422,8 @@
   month
   "Returns the current month as a value from 1 - 12."
   []
-  (PApplet/month))
+  #+clj (PApplet/month)
+  #+cljs (.month (current-applet)))

 (defn
   ^{:requires-bindings true
@@ -3454,7 +3454,6 @@
   [x y z]
   (.screenZ (current-graphics) (float x) (float y) (float z)))

-#+clj
 (defn
   ^{:requires-bindings false
     :processing-name "second()"
@@ -3464,7 +3463,8 @@
   seconds
   "Returns the current second as a value from 0 - 59."
   []
-  (PApplet/second))
+  #+clj (PApplet/second)
+  #+cljs (.second (current-applet)))

 #+clj
 (defn
@@ -4344,7 +4344,6 @@
   ([x y z u v]
      (.vertex (current-graphics) (float x) (float y) (float z) (float u) (float v))))

-#+clj
 (defn
   ^{:requires-bindings false
     :processing-name "year()"
@@ -4354,7 +4353,8 @@
   year
   "Returns the current year as an integer (2003, 2004, 2005, etc)."
   []
-  (PApplet/year))
+  #+clj (PApplet/year)
+  #+cljs (.year (current-applet)))

 (defn
   ^{:requires-bindings true


take the href off of the button

take the href off of the button

--- src/pc/views/blog/interactive_layers.clj
+++ src/pc/views/blog/interactive_layers.clj
@@ -58,7 +58,6 @@
      [:form {:method "post" :action "/duplicate/interactive-demo" :target "_blank"}
       [:input {:type "hidden" :name "__anti-forgery-token"
                :value ring.middleware.anti-forgery/*anti-forgery-token*}]
-      [:button.blog-cta-button {:href "/"
-                                     :role "button"
-                                     :title "Make something."}
+      [:button.blog-cta-button {:role "button"
+                                :title "Make something."}
        "Reproduce this demo"]]])})


(PDB-2252) command-app: verify-accepts-json earlier

--- src/puppetlabs/puppetdb/http/command.clj
+++ src/puppetlabs/puppetdb/http/command.clj
@@ -128,12 +128,12 @@
   (-> (routes enqueue-fn get-response-pub)
       mid/make-pdb-handler
       validate-command-version
-      mid/verify-accepts-json
       add-received-param ;; must be (temporally) after validate-query-params
       ;; The checksum here is vestigial.  It is no longer checked
       (mid/validate-query-params {:optional ["checksum" "secondsToWaitForCompletion"
                                              "certname" "command" "version"]})
       mid/payload-to-body-string
+      mid/verify-accepts-json
       (mid/verify-content-type ["application/json"])
       (mid/fail-when-payload-too-large reject-large-commands? max-command-size)
       (mid/wrap-with-metrics (atom {}) http/leading-uris)


Fix index file mimetypes (fixes #124)

Fix index file mimetypes (fixes #124)

--- src/compojure/route.clj
+++ src/compojure/route.clj
@@ -2,13 +2,17 @@
   "Route functions that define common behavior."
   (:require [compojure.response :as response]
             [compojure.core :refer [GET rfn]]
-            [ring.util.response :refer [file-response resource-response status]]
-            [ring.middleware.content-type :refer [wrap-content-type]]))
+            [ring.util.mime-type :as mime]
+            [ring.util.response :refer [file-response resource-response
+                                        status content-type]]))

-(defn- add-wildcard
-  "Add a wildcard to the end of a route path."
-  [^String path]
+(defn- add-wildcard [^String path]
   (str path (if (.endsWith path "/") "*" "/*")))
+
+(defn- add-mime-type [response path options]
+  (if-let [mime-type (mime/ext-mime-type path (:mime-types options {}))]
+    (content-type response mime-type)
+    response))

 (defn files
   "A route for serving static files from a directory. Accepts the following
@@ -16,10 +20,11 @@
     :root       - the root path where the files are stored, defaults to 'public'
     :mime-types - an optional map of file extensions to mime types"
   [path & [options]]
-  (-> (GET (add-wildcard path) {{file-path :*} :route-params}
-        (let [options (merge {:root "public"} options)]
-          (file-response file-path options)))
-      (wrap-content-type options)))
+  (GET (add-wildcard path) {{file-path :*} :route-params}
+    (let [options  (merge {:root "public"} options)
+          response (file-response file-path options)]
+      (if response
+        (add-mime-type response (str (:body response)) options)))))

 (defn resources
   "A route for serving resources on the classpath. Accepts the following
@@ -27,10 +32,10 @@
     :root       - the root prefix path of the resources, defaults to 'public'
     :mime-types - an optional map of file extensions to mime types"
   [path & [options]]
-  (-> (GET (add-wildcard path) {{resource-path :*} :route-params}
-        (let [root (:root options "public")]
-          (resource-response (str root "/" resource-path))))
-      (wrap-content-type options)))
+  (GET (add-wildcard path) {{resource-path :*} :route-params}
+    (let [root (:root options "public")]
+      (some-> (resource-response (str root "/" resource-path))
+              (add-mime-type resource-path options)))))

 (defn not-found
   "A route that returns a 404 not found response, with its argument as the


Add :ending-before qualifier

Add :ending-before qualifier

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -207,7 +207,15 @@
                              java-stop-time (.addTo java-completion-time java-start-time)
                              start-time (tuc/java-time->timestamp java-start-time)
                              stop-time (tuc/java-time->timestamp java-stop-time)]
-                         [start-time stop-time])))))
+                         [start-time stop-time])
+       :ending-before (let [subsequent-java-start-time java-reference-time
+                            java-changeover
+                            (Duration/ofSeconds (Math/round (typical-stage-completion-changeover)))
+                            java-stop-time (.minus subsequent-java-start-time java-changeover)
+                            java-start-time (.minus java-stop-time java-completion-time)
+                            start-time (tuc/java-time->timestamp java-start-time)
+                            stop-time (tuc/java-time->timestamp java-stop-time)]
+                        [start-time stop-time])))))

 (defn rand-easting []
   (let [minimum-easting 167000


Correct error in typical-density

Correct error in typical-density

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -43,14 +43,12 @@
 (def rand-volume-unit (rand-unit :volume))

 (defn convert-units-f [from to]
-  (let [factors   {[:lb-per-cu-ft :kg-per-m3] 16.0185
-                   [:ft-lb :J]                1.35582
+  (let [factors   {[:ft-lb :J]                1.35582
                    [:m :ft]                   3.28084
                    [:kg :lb]                  2.20462262185
                    ;; slurry rate conversion not needed (use [:bbl :m3])
                    [:m3 :bbl]                 6.28981077}
-        converter {[:lb-per-cu-ft :kg-per-m3] #(* % (factors [:lb-per-cu-ft :kg-per-m3]))
-                   [:kg-per-m3 :lb-per-cu-ft] #(/ % (factors [:lb-per-cu-ft :kg-per-m3]))
+        converter {[:kg-per-m3 :lb-per-cu-ft] #(/ % (factors [:lb-per-cu-ft :kg-per-m3]))
                    [:ft-lb :J]                #(* % (factors [:ft-lb :J]))
                    [:J :ft-lb]                #(/ % (factors [:ft-lb :J]))
                    [:ft :m]                   #(/ % (factors [:m :ft]))
@@ -586,19 +584,17 @@
      (typical-density density-unit substance)))
   ([density-unit substance]
    (condp = density-unit
-     :lb-per-cu-ft (let [[density _ substance] (typical-density :kg-per-m3)]
-                     [((convert-units-f :kg-per-m3 :lb-per-cu-ft) density) :lb-per-cu-ft substance])
-     :kg-per-m3    (condp = substance
-                     ;; Typical values for different substances taken from
-                     ;; https://serc.carleton.edu/mathyouneed/density/index.html#:~:text=Typical%20densities%20for%20gasses%20are,or%207%20g%2Fcm3.
-                     ;; accessed on 23-Dec-2020. Additionally, the data for metals was taken from
-                     ;; https://theengineeringmindset.com/density-of-metals/ accessed on 23-Dec-2020.
-                     (let [density (condp = substance
-                                     :gas    (tuc/draw-normal 1 0.11)
-                                     :liquid (tuc/draw-normal 1000 110)
-                                     :rock   (tuc/draw-normal 3000 330)
-                                     :metal  (tuc/draw-normal) 10355 5431)]
-                       [density density-unit substance])))))
+     :lb-per-cu-ft (density-as (typical-density :kg-per-m3 substance) :lb-per-cu-ft)
+     :kg-per-m3 (let [density (condp = substance
+                                ;; Typical values for different substances taken from
+                                ;; https://serc.carleton.edu/mathyouneed/density/index.html#:~:text=Typical%20densities%20for%20gasses%20are,or%207%20g%2Fcm3.
+                                ;; accessed on 23-Dec-2020. Additionally, the data for metals was taken from
+                                ;; https://theengineeringmindset.com/density-of-metals/ accessed on 23-Dec-2020.
+                                :gas    (tuc/draw-normal 1 0.11)
+                                :liquid (tuc/draw-normal 1000 110)
+                                :rock   (tuc/draw-normal 3000 330)
+                                :metal  (tuc/draw-normal) 10355 5431)]
+                  (make-measurement density density-unit substance)))))

 (defn typical-total-pump-energy
   ([]
@@ -614,12 +610,12 @@
    ;; Retrieved from http://www.excoresources.com/appalachia/ and
    ;; https://en.wikipedia.org/wiki/Casing_string on 28-Dec-2020.
    (let [typical-casing-outer-diameter-inches (+ 5 (/ 1 2))
-         typical-casing-pipe-witdth-inches    0.545
+         typical-casing-pipe-width-inches 0.545
          typical-casing-inner-diameter-inches (- typical-casing-outer-diameter-inches
-                                                 typical-casing-pipe-witdth-inches)
-         typical-casing-area-sq-inches        (* 2 Math/PI (/ typical-casing-inner-diameter-inches 2))
-         typical-pressure-psi                 (magnitude (typical-surface-treating-pressure :psi))
-         typical-force-lbf                    (* typical-pressure-psi typical-casing-area-sq-inches)]
+                                                 typical-casing-pipe-width-inches)
+         typical-casing-area-sq-inches (* 2 Math/PI (/ typical-casing-inner-diameter-inches 2))
+         typical-pressure-psi (magnitude (typical-surface-treating-pressure :psi))
+         typical-force-lbf (* typical-pressure-psi typical-casing-area-sq-inches)]
      (condp = force-unit
        :lbf (make-measurement typical-force-lbf force-unit)
        :N   (force-as (typical-force :lbf) :N)))))
@@ -637,7 +633,4 @@
         measurement (generate-measurement-f unit)]
     [measurement (measurement-as-f measurement (first (remove (partial = unit) units)))]))

-(generate-measurement-pair #{:lb-per-gal :kg-per-m3}
-                           rand-proppant-concentration-unit
-                           typical-proppant-concentration
-                           proppant-concentration-as)
+(generate-measurement-pair #{:lb-per-cu-ft :kg-per-m3} rand-density-unit typical-density density-as)


Correct typical-force use of pressure

Correct typical-force use of pressure

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -608,7 +608,7 @@
          typical-casing-inner-diameter-inches (- typical-casing-outer-diameter-inches
                                                  typical-casing-pipe-witdth-inches)
          typical-casing-area-sq-inches        (* 2 Math/PI (/ typical-casing-inner-diameter-inches 2))
-         typical-pressure-psi                 (typical-surface-treating-pressure :psi)
+         typical-pressure-psi                 (magnitude (typical-surface-treating-pressure :psi))
          typical-force-lbf                    (* typical-pressure-psi typical-casing-area-sq-inches)]
      (condp = force-unit
        :lbf [typical-force-lbf force-unit]


Draw cell backgrounds and borders correctly.

--- src/snergly/image.cljs
+++ src/snergly/image.cljs
@@ -25,16 +25,20 @@
           cell (g/grid-cell grid coord)]
       (draw-fn cell cell-size x1 y1 x2 y2))))

-(defn draw-cell-background [g cell cell-size x1 y1 _ _]
-  (let [color (:color cell)]
-    (when color (fill-rect g color x1 y1 cell-size cell-size))))
+(defn draw-cell-background [g cell cell-size x y _ _]
+  (let [color (:color cell)
+        ;[x w] (if (g/linked? cell (:west cell)) [(dec x) (inc cell-size)] [x cell-size])
+        ;[y h] (if (g/linked? cell (:north cell)) [(dec y) (inc cell-size)] [y cell-size])
+        w (if (g/linked? cell (:east cell)) (inc cell-size) cell-size)
+        h (if (g/linked? cell (:south cell)) (inc cell-size) cell-size)]
+    (when color (fill-rect g color x y w h))))

 (defn draw-cell-walls [g background wall cell _ x1 y1 x2 y2]
   (when-not (:north cell) (draw-line g wall x1 y1 x2 y1))
   (when-not (:west cell) (draw-line g wall x1 y1 x1 y2))

-  (draw-line g (if (g/linked? cell (:east cell)) background wall) x2 y1 x2 y2)
-  (draw-line g (if (g/linked? cell (:south cell)) background wall) x1 y2 x2 y2))
+  (when-not (g/linked? cell (:east cell)) (draw-line g wall x2 y1 x2 y2))
+  (when-not (g/linked? cell (:south cell)) (draw-line g wall x1 y2 x2 y2)))

 (defn image-grid [g {:keys [rows columns] :as grid} cell-size]
   (let [img-width (inc (* cell-size columns))


make sure target groups get autoscaling group instances

--- src/terraboot/core.clj
+++ src/terraboot/core.clj
@@ -331,7 +331,7 @@
                             :launch_configuration (cluster-output-of "aws_launch_configuration" name "name")
                             :lifecycle { :create_before_destroy true }
                             :load_balancers (mapv #(cluster-output-of "aws_elb" (:name %) "name") (:elb spec))
-                            :target_group_arns (mapv #(cluster-output-of "aws_alb_target_group" (:name %) "arn") (:listeners (spec :alb)))
+                            :target_group_arns (mapv #(cluster-output-of "aws_alb_target_group" (:name %) "arn") (mapcat :listeners (:alb spec)))
                             :tag {:key "Name"
                                   :value (name-fn name)
                                   :propagate_at_launch true


defaults for navigation to reduce boiler-plate

--- frontend/controllers/navigation.cljs
+++ frontend/controllers/navigation.cljs
@@ -1,5 +1,6 @@
 (ns frontend.controllers.navigation
   (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer close!]]
+            [clojure.string :as str]
             [frontend.async :refer [put!]]
             [frontend.api :as api]
             [frontend.pusher :as pusher]
@@ -37,12 +38,13 @@

 (defmethod navigated-to :default
   [history-imp navigation-point args state]
-  (mlog "Unknown nav event: " (pr-str navigation-point))
-  state)
+  (-> state
+      (assoc :navigation-point navigation-point
+             :navigation-data args)))

 (defmethod post-navigated-to! :default
   [history-imp navigation-point args previous-state current-state]
-  (mlog "No post-nav for: " navigation-point))
+  (set-page-title! (str/capitalize (name navigation-point))))

 (defmethod post-navigated-to! :navigate!
   [history-imp navigation-point path previous-state current-state]
@@ -295,33 +297,3 @@
                      404 "Page not found"
                      500 "Internal server error"
                      "Something unexpected happened")))
-
-(defmethod navigated-to :about
-  [history-imp navigation-point args state]
-  (-> state
-      (assoc :navigation-point navigation-point
-             :navigation-data args)))
-
-(defmethod navigated-to :pricing
-  [history-imp navigation-point args state]
-  (-> state
-      (assoc :navigation-point navigation-point
-             :navigation-data args)))
-
-(defmethod navigated-to :jobs
-  [history-imp navigation-point args state]
-  (-> state
-      (assoc :navigation-point navigation-point
-             :navigation-data args)))
-
-(defmethod navigated-to :privacy
-  [history-imp navigation-point args state]
-  (-> state
-      (assoc :navigation-point navigation-point
-             :navigation-data args)))
-
-(defmethod navigated-to :security
-  [history-imp navigation-point args state]
-  (-> state
-      (assoc :navigation-point navigation-point
-             :navigation-data args)))


(PDB-3304) Paramterize test URL functions with base-url

In extensions tests we often need to have multiple PuppetDBs and can't
rely on *base-url* to be correct. This commit parameterizes the URL
functions for the HTTP test client code to allow either the *base-url*
var or the base-url

--- test/puppetlabs/puppetdb/testutils/services.clj
+++ test/puppetlabs/puppetdb/testutils/services.clj
@@ -146,35 +146,65 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn pdb-query-url []
-  (assoc *base-url* :prefix "/pdb/query" :version :v4))
-
-(defn query-url-str [url-suffix]
-  (create-url-str (pdb-query-url) url-suffix))
-
-(defn pdb-cmd-url []
-  (assoc *base-url* :prefix "/pdb/cmd" :version :v1))
-
-(defn cmd-url-str [url-suffix]
-  (create-url-str (pdb-cmd-url) url-suffix))
-
-(defn pdb-admin-url []
-  (assoc *base-url* :prefix "/pdb/admin" :version :v1))
-
-(defn admin-url-str [url-suffix]
-  (create-url-str (pdb-admin-url) url-suffix))
-
-(defn pdb-metrics-url []
-  (assoc *base-url* :prefix "/metrics" :version :v1))
-
-(defn metrics-url-str [url-suffix]
-  (create-url-str (pdb-metrics-url) url-suffix))
-
-(defn pdb-meta-url []
-  (assoc *base-url* :prefix "/pdb/meta" :version :v1))
-
-(defn meta-url-str [url-suffix]
-  (create-url-str (pdb-meta-url) url-suffix))
+(defn pdb-query-url
+  ([]
+   (pdb-query-url *base-url*))
+  ([base-url]
+   (assoc base-url :prefix "/pdb/query" :version :v4)))
+
+(defn query-url-str
+  ([url-suffix]
+   (query-url-str *base-url* url-suffix))
+  ([base-url url-suffix]
+   (create-url-str (pdb-query-url base-url) url-suffix)))
+
+(defn pdb-cmd-url
+  ([]
+   (pdb-cmd-url *base-url*))
+  ([base-url]
+   (assoc base-url :prefix "/pdb/cmd" :version :v1)))
+
+(defn cmd-url-str
+  ([url-suffix]
+   (cmd-url-str *base-url* url-suffix))
+  ([base-url url-suffix]
+   (create-url-str (pdb-cmd-url base-url) url-suffix)))
+
+(defn pdb-admin-url
+  ([]
+   (pdb-admin-url *base-url*))
+  ([base-url]
+   (assoc base-url :prefix "/pdb/admin" :version :v1)))
+
+(defn admin-url-str
+  ([url-suffix]
+   (admin-url-str *base-url* url-suffix))
+  ([base-url url-suffix]
+   (create-url-str (pdb-admin-url base-url) url-suffix)))
+
+(defn pdb-metrics-url
+  ([]
+   (pdb-metrics-url *base-url*))
+  ([base-url]
+   (assoc base-url :prefix "/metrics" :version :v1)))
+
+(defn metrics-url-str
+  ([url-suffix]
+   (metrics-url-str *base-url* url-suffix))
+  ([base-url url-suffix]
+   (create-url-str (pdb-metrics-url base-url) url-suffix)))
+
+(defn pdb-meta-url
+  ([]
+   (pdb-meta-url *base-url*))
+  ([base-url]
+   (assoc base-url :prefix "/pdb/meta" :version :v1)))
+
+(defn meta-url-str
+  ([url-suffix]
+   (meta-url-str *base-url* url-suffix))
+  ([base-url url-suffix]
+   (create-url-str (pdb-meta-url base-url) url-suffix)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -227,10 +257,10 @@
    & [opts]]
   (let [resp (get url-str opts)]
     (if (>= (:status resp) 400)
-      (throw (ex-info
-              (format "Failed request to '%s' with status '%s'" url-str (:status resp))
-              {:url url-str
-               :response resp}))
+      (throw+ {:url url-str
+               :response resp
+               :status (:status resp)}
+              (format "Failed request to '%s' with status '%s'" url-str (:status resp)))
       resp)))

 (pls/defn-validated post
@@ -260,15 +290,28 @@
 (defn certname-query
   "Returns a function that will query the given endpoint (`suffix`)
   for the provided `certname`"
-  [suffix]
-  (fn [certname]
-    (-> (query-url-str suffix)
-        (get-or-throw {:query-params {"query" (json/generate-string [:= :certname certname])}})
-        :body)))
-
-(def get-reports (certname-query "/reports"))
-(def get-factsets (certname-query "/factsets"))
-(def get-catalogs (certname-query "/catalogs"))
+  [base-url suffix certname]
+  (-> (query-url-str base-url suffix)
+      (get-or-throw {:query-params {"query" (json/generate-string [:= :certname certname])}})
+      :body))
+
+(defn get-reports
+  ([certname]
+   (get-reports *base-url* certname))
+  ([base-url certname]
+   (certname-query base-url "/reports" certname)))
+
+(defn get-factsets
+  ([certname]
+   (get-factsets *base-url* certname))
+  ([base-url certname]
+   (certname-query base-url "/factsets" certname)))
+
+(defn get-catalogs
+  ([certname]
+   (get-catalogs *base-url* certname))
+  ([base-url certname]
+   (certname-query base-url "/catalogs" certname)))

 (defn get-summary-stats []
   (-> (admin-url-str "/summary-stats")


imlementing whole lifecycle, starting to add selections

--- src/docker/provider.clj
+++ src/docker/provider.clj
@@ -12,7 +12,8 @@
 (ns docker.provider
   "Provides Docker support in Celestial "
   (:require
-    [docker.remote :as r]
+    [slingshot.slingshot :refer  [throw+ try+]]
+    [docker.client :as c]
     [trammel.core :refer (defconstrainedrecord)]
     [clojure.core.strint :refer (<<)]
     [celestial.model :refer (translate vconstruct)]
@@ -23,31 +24,49 @@

 (import-logging)

-(defconstrainedrecord Container [node container]
+(defn container-id
+   "grab container id"
+   [system-id]
+  (get-in (s/get-system system-id) [:docker :container-id]))
+
+(defconstrainedrecord Container [node create-spec start-spec system-id ]
   "A docker container instance"
   []
   Vm
   (create [this]
-
-    )
+    (let [{:keys [id]} (c/create node create-spec)]
+      (when (s/system-exists? id)
+         (s/partial-system id {:docker {:container-id id}})))
+       this)

   (start [this]
+     (c/start node (container-id system-id) start-spec)
     )

   (delete [this]
+    (c/delete node (container-id system-id))
     )

   (stop [this]
+    (c/stop node (container-id system-id))
     )

   (status [this]
-    ))
+    (try+
+      (let [{:keys [running]} (:state (c/inspect :local (container-id system-id)))]
+        (if running "running" "stopped"))
+      (catch [:status 404] e false)))
+  )
+
+(def starts-ks [:port-bindings :binds])
+
+(def create-ks [:image :exposed-ports :volumes])

 (defmethod translate :docker [{:keys [machine docker system-id] :as spec}]
   "Convert the general model into a docker specific one"
-   (merge machine docker {:system-id system-id}))
+   (let [{:keys [node]} docker]
+     [node (merge machine docker) system-id]))

 (defmethod vconstruct :docker [{:keys [docker] :as spec}]
-  (let [{:keys [type node]} docker]
-    (apply ->Container node (translate spec))
-    ))
+    (apply ->Container (translate spec))
+    )


oops, server name should include "subrosa"...

--- src/subrosa/server.clj
+++ src/subrosa/server.clj
@@ -19,7 +19,7 @@
 (defonce db (ref (make-subrosa-db)))

 (defonce server {:host (.getHostName (InetAddress/getLocalHost))
-                 :version (.trim (slurp "etc/version.txt"))
+                 :version (str "subrosa-" (.trim (slurp "etc/version.txt")))
                  :started (Date.)})

 (defn reset-all-state! []


board is just global but not dynamic

board is just global but not dynamic

--- src/tile_game/core.clj
+++ src/tile_game/core.clj
@@ -26,7 +26,7 @@
                                      (int (+ cx (quot scale 2)))
                                      (int (+ cy (quot scale 2)))))))

-(def ^:dynamic *board* (ref (create-board 2)))
+(def board (ref (create-board 2)))

 (defn start-gui [dim]
   (let [size (* dim scale)
@@ -34,16 +34,16 @@
         #^JPanel panel (proxy [JPanel] []
                          (paint [g]
                            (doseq [x (range dim) y (range dim)]
-                             (render-tile g @*board* [x y]))))
+                             (render-tile g @board [x y]))))
         slide! (fn [& moves]
                  (prn :slide! moves)
                  (send (agent moves)
                        (fn [moves]
                          (doseq [piece moves]
-                           (dosync (alter *board* slide piece))
+                           (dosync (alter board slide piece))
                            (.repaint panel)
                            (Thread/sleep 150)))))
-        shuffle-board! (fn [dim] (dosync (ref-set *board*
+        shuffle-board! (fn [dim] (dosync (ref-set board
                                                   (create-board dim :shuffle))))]
     (shuffle-board! dim)
     (doto panel
@@ -59,7 +59,7 @@
                          KeyEvent/VK_DOWN  (slide! :down)
                          KeyEvent/VK_Q     (.dispose #^JFrame frame)
                          KeyEvent/VK_R     (do (shuffle-board! dim) (.repaint panel))
-                         KeyEvent/VK_S     (apply slide! (solve-next @*board*))
+                         KeyEvent/VK_S     (apply slide! (solve-next @board))
                          true)))))
     (doto frame (.setContentPane panel) .pack .show)
     slide!))


Use java.io.tmpdir for storing the exported files

--- reports/src/reports/exporter.clj
+++ reports/src/reports/exporter.clj
@@ -9,12 +9,16 @@
     "xls"
     "xlsx"))

+(defn- get-path []
+  (format "%s/%s/%s" (System/getProperty "java.io.tmpdir") "akvo/flow/reports" (UUID/randomUUID)))
+
 (defn- get-file [et id]
-  (let [path (str "/var/tmp/akvo/flow/reports/" (UUID/randomUUID))]
+  (let [path (get-path)]
     (.mkdirs (io/file path))
     (io/file (format "%s/%s-%s.%s" path et id (get-file-extension et)))))

 (defn ^File export-report [type base id options]
   (let [exporter (.getExporter (SurveyDataImportExportFactory.) type)
         file (get-file type id)]
-    (.export exporter {"surveyId" id} file base options) file))
+    (.export exporter {"surveyId" id} file base options)
+    file))


Forbid newlines between expr and postfix ++.

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -101,8 +101,8 @@
        quoted-chunks (map #(str quote % quote) chunks)
        quoted-tokens (map (fn [t] {:value t :type "String"}) quoted-chunks)
        interleaved (butlast (interleave quoted-tokens (cycle [plus])))]
-    ;[token]   ;  == do nothing
-    interleaved
+    [token]   ;  == do nothing
+    ;interleaved
     ))

 (defn split-string-literals [tokens l]
@@ -118,15 +118,22 @@
     (nil? t1) result
     (nil? t2) (conj result (:value t1))
     :else     (let [not-punct? #(not= (:type %) "Punctuator")
+                    tok-line   #(get-in % [:loc :end :line])
+                    same-line? #(= (tok-line %1) (tok-line %2))
+
                     need-space (and (not-punct? t1) (not-punct? t2))
-                    t1-text    (str (:value t1) (if need-space " " ""))]
-              (recur (conj tokens t2) (conj result t1-text)))))
+                    glue-toks  (and (= (:value t2) "++") (same-line? t1 t2))]
+              (cond
+                glue-toks  (recur tokens           (conj result (str (:value t1) (:value t2))))
+                need-space (recur (conj tokens t2) (conj result (str (:value t1) " ")))
+                :else      (recur (conj tokens t2) (conj result (str (:value t1))))))))

 (defn analyze-code [code]
   (let [ast (js/esprima.parse code)
         regenerated (js/escodegen.generate ast)
-        tokens (js->clj (js/esprima.tokenize regenerated) :keywordize-keys true)]
-    (tokens-to-text (split-string-literals tokens 5) [])))
+        tokens (js->clj (js/esprima.tokenize regenerated (clj->js {:loc true})) :keywordize-keys true)]
+    (tokens-to-text tokens [])))
+    ;(tokens-to-text (split-string-literals tokens 5) [])))

 (defn invert-image [img]
   (let [invert-row (fn [row] (map #(if (= % 0) 1 0) row))]


removing unused require-statements

removing unused require-statements

--- src/lambdacd/server.clj
+++ src/lambdacd/server.clj
@@ -4,11 +4,8 @@
             [clojure.data.json :as json :only [write-str]]
             [lambdacd.presentation :as presentation]
             [lambdacd.manualtrigger :as manualtrigger]
-            [lambdacd.execution :as execution]
-            [lambdacd.pipeline-state :as pipeline-state]
             [lambdacd.util :as util]
-            [ring.util.response :as resp]
-            [clojure.core.async :as async]))
+            [ring.util.response :as resp]))

 (defn- pipeline [pipeline-def]
   (presentation/display-representation pipeline-def))
@@ -32,4 +29,3 @@
   (GET "/" [] (resp/resource-response "index.html" {:root "public"}))
   (route/resources "/")
   (route/not-found "
Page not found
")))
-


refactoring

refactoring

--- src/babel/italiano/lab.cljc
+++ src/babel/italiano/lab.cljc
@@ -158,34 +158,47 @@
   []
   (let [spec
         {:modified false
-         :synsem {:cat :verb
-                  :subcat []
-                  :sem {:pred :top
-                        :tense :present
-                        :aspect :simple
-                        :subj {:pred :top}
-                        :obj {:pred :top}}}
-         :head {:comp {:synsem {:pronoun true}}}}]
+         :phrasal true
+         :synsem {:aux false
+                  :cat :verb
+                  :subcat []
+                  :sem {:pred :top
+                        :tense :present
+                        :aspect :simple
+                        :subj {:pred :top}
+                        :obj {:pred :top}}}
+         :comp {:phrasal false}
+         :head {:phrasal true
+                :head {:phrasal false}
+                :comp {:phrasal false
+                       :synsem {:pronoun true}}}}]
     (repeatedly #(-> spec generate morph time println))))

 (defn sentences-with-pronoun-objects-small []
   (let [lexicon (:lexicon model)
+        transitive? (fn [lexeme]
+                      (and (= (get-in lexeme [:synsem :cat])
+                              :verb)
+                           (= (get-in lexeme [:synsem :aux] false)
+                              false)
+                           (not (empty? (get-in lexeme [:synsem :subcat] [])))
+                           (map? (get-in lexeme [:synsem :subcat :2]))
+                           (empty? (get-in lexeme [:synsem :subcat :3] []))))
+
         transitive-verbs
         (filter (fn [k]
                   (let [lexemes (->> (get lexicon k)
-                                     (filter (fn [lexeme]
-                                               (and (= (get-in lexeme [:synsem :cat])
-                                                       :verb)
-                                                    (= (get-in lexeme [:synsem :aux] false)
-                                                       false)
-                                                    (not (empty? (get-in lexeme [:synsem :subcat] [])))
-                                                    (map? (get-in lexeme [:synsem :subcat :2]))
-                                                    (empty? (get-in lexeme [:synsem :subcat :3] []))))))]
+                                     (filter transitive?))]
                     (not (empty? lexemes))))
                 (keys lexicon))

-        chosen-subset (set (take 3 (shuffle transitive-verbs)))
-
+        chosen-subset (set (take 10 (shuffle transitive-verbs)))
+
+        pronoun? (fn [lexeme]
+                   (and (= (get-in lexeme [:synsem :cat])
+                           :noun)
+                        (= (get-in lexeme [:synsem :pronoun])
+                           true)))
         model
         (model-plus-lexicon
          ;; filtered lexicon:
@@ -194,35 +207,22 @@
                  (let [filtered-lexemes
                        (filter (fn [lexeme]
                                  (or (and
-
-                                      ;; must have the same surface form as the
-                                      ;; three randomly-chosen words above.
                                       (contains? chosen-subset k)
-
-                                      ;; must be a transitive verb: exactly 2 arguments (subject and object).
-                                      (= (get-in lexeme [:synsem :cat]) :verb)
-                                      (not (empty? (get-in lexeme [:synsem :subcat] [])))
-                                      (map? (get-in lexeme [:synsem :subcat :2]))
-                                      (empty? (get-in lexeme [:synsem :subcat :3] [])))
-
-                                     (and (= (get-in lexeme [:synsem :cat])
-                                             :noun)
-                                          (= (get-in lexeme [:synsem :pronoun])
-                                             true))))
+                                      (transitive? lexeme))
+                                     (pronoun? lexeme)))
                                lexemes)]
                    (if (not (empty? filtered-lexemes))
                      [k filtered-lexemes]))))

-         ;; filtered grammar:
+         ;; no filters on rules:
          (fn [rule]
-           (or (= (:rule rule)
-                  "s-present-phrasal")
-               (= (:rule rule)
-                  "vp-pronoun-nonphrasal"))))
+           true))
+
         spec
         {:modified false
          :phrasal true
-         :synsem {:cat :verb
+         :synsem {:aux false
+                  :cat :verb
                   :subcat []
                   :sem {:pred :top
                         :tense :present


Save badges, get gallery id first

Save badges, get gallery id first

--- src/clj/salava/badge/db.clj
+++ src/clj/salava/badge/db.clj
@@ -212,47 +212,51 @@
     badge-id))

-(defn save-gallery! [tx badge]
-  (let [badge-content  (first (filter #(= (:language_code %) (:default_language_code badge)) (:content badge)))
+(defn save-gallery! [ctx badge]
+  (let [conn (:connection (u/get-db ctx))
+        badge-content  (first (filter #(= (:language_code %) (:default_language_code badge)) (:content badge)))
         issuer-content (first (filter #(= (:language_code %) (:default_language_code badge)) (:issuer  badge)))]

-    (jdbc/execute! tx ["INSERT IGNORE INTO gallery (badge_name, badge_image, issuer_name) VALUES (?,?,?)"
-                       (:name badge-content) (:image_file badge-content) (:name issuer-content)])
+    (jdbc/execute! conn ["INSERT IGNORE INTO gallery (badge_name, badge_image, issuer_name) VALUES (?,?,?)"
+                         (:name badge-content) (:image_file badge-content) (:name issuer-content)])
     (some->
-      (jdbc/query tx ["SELECT id FROM gallery
-                      WHERE badge_name = ? AND badge_image = ? AND issuer_name = ?"
-                      (:name badge-content) (:image_file badge-content) (:name issuer-content)])
+      (jdbc/query conn ["SELECT id FROM gallery
+                        WHERE badge_name = ? AND badge_image = ? AND issuer_name = ?"
+                        (:name badge-content) (:image_file badge-content) (:name issuer-content)])
       first :id)))

 (defn save-user-badge! [ctx user-badge]
-  (jdbc/with-db-transaction  [tx (:connection (u/get-db ctx))]
-    (let [now (u/now)
-          badge    (save-images ctx (:badge user-badge))
-          badge-id (save-badge! tx badge)
-          gallery-id (save-gallery! tx badge)
-          user-badge-id (-> user-badge
-                            (dissoc :badge)
-                            (assoc :badge_id badge-id)
-                            (insert-user-badge<! {:connection tx})
-                            :generated_key)]
-
-      (when gallery-id
-        (jdbc/execute! tx ["UPDATE gallery SET badge_id = ? WHERE id = ?" badge-id gallery-id])
-        (jdbc/execute! tx ["UPDATE user_badge SET gallery_id = ? WHERE id = ?" gallery-id user-badge-id]))
-
-      (when (seq (:evidence user-badge))
-        (doseq [evidence (:evidence user-badge)]
-          (when (map? evidence)
-            (jdbc/insert! tx "user_badge_evidence" (-> evidence
-                                                       (dissoc :id)
-                                                       (assoc :user_badge_id user-badge-id
-                                                              :ctime now
-                                                              :mtime now))))))
-      (when (seq (:endorsement user-badge))
-        (doseq [endorsement (:endorsement user-badge)]
-          (when (map? endorsement)
-            (jdbc/insert! tx "user_badge_endorsement" (-> endorsement
-                                                          (dissoc :id)
-                                                          (assoc :user_badge_id user-badge-id :status "accepted"))))))
-      user-badge-id)))
+  (let [badge      (save-images ctx (:badge user-badge))
+        gallery-id (save-gallery! ctx badge)]
+
+    (println (str "got gallery id " gallery-id))
+
+    (jdbc/with-db-transaction  [tx (:connection (u/get-db ctx))]
+      (let [now (u/now)
+            badge-id (save-badge! tx badge)
+            user-badge-id (-> user-badge
+                              (dissoc :badge)
+                              (assoc :badge_id badge-id)
+                              (insert-user-badge<! {:connection tx})
+                              :generated_key)]
+
+        (when gallery-id
+          (jdbc/execute! tx ["UPDATE gallery SET badge_id = ? WHERE id = ?" badge-id gallery-id])
+          (jdbc/execute! tx ["UPDATE user_badge SET gallery_id = ? WHERE id = ?" gallery-id user-badge-id]))
+
+        (when (seq (:evidence user-badge))
+          (doseq [evidence (:evidence user-badge)]
+            (when (map? evidence)
+              (jdbc/insert! tx "user_badge_evidence" (-> evidence
+                                                         (dissoc :id)
+                                                         (assoc :user_badge_id user-badge-id
+                                                                :ctime now
+                                                                :mtime now))))))
+        (when (seq (:endorsement user-badge))
+          (doseq [endorsement (:endorsement user-badge)]
+            (when (map? endorsement)
+              (jdbc/insert! tx "user_badge_endorsement" (-> endorsement
+                                                            (dissoc :id)
+                                                            (assoc :user_badge_id user-badge-id :status "accepted"))))))
+        user-badge-id))))


remove nil dispatches bugfix. added warning debug message

--- src/cljs/re_dnd/events.cljs
+++ src/cljs/re_dnd/events.cljs
@@ -265,22 +265,21 @@
         drop-zones-being-hit? :dnd/get-colliding-drop-zone-and-index}
        [_ source-draggable-id source-drop-zone-id]]
    (debug drop-zones-being-hit?)
-   (debug "dispatches: "
-          (for [[drop-zone-id [[dropped-element-id index]]] drop-zones-being-hit?]
-            (let [options                  (get-in db [:dnd/state :drop-zone-options drop-zone-id])
-                  drag-target-hit-dispatch (into (:drop-dispatch options)
-                                                 [[source-drop-zone-id source-draggable-id]
-                                                  [drop-zone-id dropped-element-id index]])]
-              drag-target-hit-dispatch)))
-
-   {:db         (set-all-draggables-to-idle db)
-    :dispatch-n (vec (for [[drop-zone-id [[dropped-element-id index]]] drop-zones-being-hit?]
-                       (let [options                  (get-in db [:dnd/state :drop-zone-options drop-zone-id])
-                             _ (debug options)
-                             drag-target-hit-dispatch (into (:drop-dispatch options)
-                                                            [[source-drop-zone-id source-draggable-id]
-                                                             [drop-zone-id dropped-element-id index]])]
-                         drag-target-hit-dispatch)))}))
+   (let [disps (for [[drop-zone-id [[dropped-element-id index]]] drop-zones-being-hit?]
+                 (let [options                  (get-in db [:dnd/state :drop-zone-options drop-zone-id])
+                       _                        (debug options)
+                       drag-target-hit-dispatch (if (:drop-dispatch options)
+                                                  (into (:drop-dispatch options)
+                                                        [[source-drop-zone-id source-draggable-id]
+                                                         [drop-zone-id dropped-element-id index]])
+                                                  (do
+                                                    (warn "No options found for drop-zone-id: " drop-zone-id ", make sure it is properly initialized. Ignoring")
+                                                    nil))]
+                   drag-target-hit-dispatch))
+         disps (remove nil? disps)]
+     (debug "dispatches: " disps)
+     {:db         (set-all-draggables-to-idle db)
+      :dispatch-n (vec disps)})))

 (re-frame/reg-event-db
  :dnd/reorder-drop


comments

comments

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -13,10 +13,6 @@
 ;; TODO - Extract the parts that are related to costmetic: Help
 ;; TODO - Rework the game loop to be a state machine (beware of consuming messages)

-;; -----------------------------------------
-;; PLUGGING THE BLOCKS
-;; -----------------------------------------
-
 (defn run-game []
   (frame/main-frame @store/current-turn @store/suggestions
     (reify view/CallBacks


Checkboxes for indexing multiple tags at once from Stack Overflow

--- src/cljs/zest/settings.cljs
+++ src/cljs/zest/settings.cljs
@@ -17,6 +17,7 @@
 (def so-ul-speed (reagent/atom 0))
 (def so-grep-progress (reagent/atom nil))
 (def so-index-progress (reagent/atom nil))
+(def so-index-tags (reagent/atom #{}))
 (def so-archives-total (reagent/atom 0))
 (def so-archives-available
   (let [fs (.require js/window "fs")
@@ -43,7 +44,9 @@
    "django"
    "html"
    "c++"
-   "ios"])
+   "ios"
+   "objective-c"
+   "clojure"])

 (defn start-so-download []
   (let [WebTorrent (.require js/window "webtorrent")
@@ -122,12 +125,14 @@
                                     (nth (.split line #"\s+") 3)))))))))
     ret))

-(defn start-so-indexing [tag]
+(defn start-so-indexing []
   (reset! so-index-progress 0)
   (let [levelup (.require js/window "levelup")
         path (.require js/window "path")
+        fs (.require js/window "fs")
+        rimraf (.require js/window "rimraf")
         db (levelup.
-             (.join path (zest.docs.registry/get-so-root) "leveldb"))
+             (.join path (zest.docs.registry/get-so-root) "new_index" "leveldb"))
         rStream (.createReadStream
                   db
                   (js-obj "gt" "p_"
@@ -136,7 +141,7 @@
         LuceneIndex
         (.-LuceneIndex (.require js/window "../build/Release/nodelucene"))
         idx (LuceneIndex. (.join path (zest.docs.registry/get-so-root)
-                                 "lucene"))
+                                 "new_index" "lucene"))

         done (atom 0)
         started (atom 0)
@@ -144,7 +149,16 @@
         check-all-done
         (fn []
           (if (and @ended (= @started @done))
-            (.endWriting idx)))
+            (do
+              (.endWriting idx)
+              (.sync rimraf (.join path (zest.docs.registry/get-so-root) "lucene"))
+              (.sync rimraf (.join path (zest.docs.registry/get-so-root) "leveldb"))
+              (.renameSync
+                (.join path (zest.docs.registry/get-so-root) "new_index" "lucene")
+                (.join path (zest.docs.registry/get-so-root) "lucene"))
+              (.renameSync
+                (.join path (zest.docs.registry/get-so-root) "new_index" "leveldb")
+                (.join path (zest.docs.registry/get-so-root) "leveldb")))))

         auf
         (fn [answer]
@@ -224,20 +238,23 @@
            (reset! ended true)
            (check-all-done)))))

-(defn start-so-grepping [tag]
+(defn start-so-grepping []
   (let [mkdirp (.require js/window "mkdirp")
+        rimraf (.require js/window "rimraf")
         path (.require js/window "path")]
-    (.sync mkdirp (.join path (zest.docs.registry/get-so-root) tag))
+    (.sync rimraf (.join path (zest.docs.registry/get-so-root) "new_index"))
+    (.sync mkdirp (.join path (zest.docs.registry/get-so-root) "new_index"))
     (go (let [comments-size (async/<! (archive-size "Comments"))
               posts-size (async/<! (archive-size "Posts"))
               child-process (.require js/window "child_process")
               Lazy (.require js/window "lazy")
               Buffer (.-Buffer (.require js/window "buffer"))
               sogrep (.spawn child-process "sogrep"
-                             (array tag)
+                             (apply array @so-index-tags)
                              (js-obj "cwd"
                                      (.join path
-                                            (zest.docs.registry/get-so-root))))
+                                            (zest.docs.registry/get-so-root)
+                                            "new_index")))
               p7zip-posts (open-so-archive "Posts" "x")]
           (reset! so-indexing true)
           (.pipe (.-stdout p7zip-posts)
@@ -251,7 +268,7 @@
           (.on sogrep "close"
                (fn [code]
                  (.log js/console "sogrep exited with code" code)
-                 (if (= 0 code) (start-so-indexing tag))))
+                 (if (= 0 code) (start-so-indexing))))
           (.on p7zip-posts "close"
                (fn [code]
                  (.log js/console "7z x posts exited with code" code)
@@ -274,31 +291,39 @@
 (defn so-widget []
   (if @so-archives-available
     [:div
-     [:p "Suggested tags:"]
+     [:p "Suggested tags (select ones you want in your index):"]
      [:ul
       (doall (for [tag suggested-tags]
-               (if (nil? @so-grep-progress)
-                 (if (not @so-indexing)
-                   (do ^{:key (str "so_tags_" tag)}
-                       [:li (str tag " | ")
-                        [:a
-                         {:on-click #(start-so-grepping tag)}
-                         "generate index"]])
-                   (do
-                     ^{:key (str "so_tags_" tag)}
-                     [:li (str tag)]))
-                 (doall
-                   ^{:key (str "so_indexing_" tag)}
-                   [:li (str
-                          "Indexing " tag ": "
-                          (.toFixed
-                            (min 99.99                      ; never show 100%
-                                 (* 100 (/ @so-grep-progress
-                                           @so-archives-total)))
-                            2)
-                          "% filtering, "
-                          (or @so-index-progress 0)
-                          " indexing")]))))]]
+               (do ^{:key (str "so_tags_" tag)}
+                   [:li
+                    [:label
+                     [:input {:type     "checkbox"
+                              :checked  (get @so-index-tags tag)
+                              :disabled @so-indexing
+                              :on-change
+                                        (fn []
+                                          (if (nil? (get @so-index-tags tag))
+                                            (reset! so-index-tags
+                                                    (conj @so-index-tags tag))
+                                            (reset! so-index-tags
+                                                    (disj @so-index-tags tag))))}]
+                     [:span {:class "checkable"} tag]]]
+                   )))]
+     (if @so-indexing
+       [:p (str
+             "Indexing : "
+             (.toFixed
+               (* 100 (/ (or @so-grep-progress 0)
+                         (or @so-archives-total 1)))
+               2)
+             "% filtering, "
+             (or @so-index-progress 0)
+             " indexing")]
+       [:button {:on-click (fn []
+                             (reset! so-indexing true)
+                             (start-so-grepping))}
+        "Create index"])]
+
     [:div
      [:p "~8GB BitTorrent download required. (provided by archive.org)"]
      (if @so-downloading


Use filter-some to find POM

Use filter-some to find POM

For consistency with the find-module function.

--- src/clojars/routes/repo.clj
+++ src/clojars/routes/repo.clj
@@ -157,10 +157,7 @@
            :body nil})))))

 (defn find-pom [dir]
-  (->> dir
-    file-seq
-    (filter pom?)
-    first))
+  (util/filter-some pom? (file-seq dir)))

 (defn find-module [dir]
   (util/filter-some module? (file-seq dir)))


Support one or more forms at a time

Support one or more forms at a time

Makes working with files easier/possible. Fixes #10

--- src/clojurescript/core.cljs
+++ src/clojurescript/core.cljs
@@ -1,5 +1,6 @@
 (ns clojurescript.core
   (:require [clojure.string :as string]
+            [cljs.tools.reader.reader-types :as rt]
             [cljs.nodejs :as nodejs]
             [cljs.js :as cljsjs]
             [replumb.repl :as replumbrepl]
@@ -203,25 +204,39 @@
 ;; TODO not sure if process.cwd is a good default
 (establish-load-path)

+(defn single-form [s]
+  (let [rdr (rt/string-push-back-reader s)
+        _ (replumbrepl/read {} rdr)]
+    (try
+      (replumbrepl/read {} rdr)
+      false
+      (catch js/Error e
+        true))))
+
+(defn compile-options [in-str]
+  (merge
+    {:no-pr-str-on-value true
+     :def-emits-var true
+     :context (if (single-form in-str) :expr :statement)
+     :init-fn! replumbjs/init-fn!}
+    (replumb/options
+      :node
+      (make-load-fn
+        *load-paths*
+        (fn [filename source-cb]
+          (source-cb
+            (cond
+              (re-find #"\.jar/" filename)
+              (let [[jar-path path] (string/split filename ".jar/")
+                    zip (AdmZip. (str jar-path ".jar"))]
+                (if (.getEntry zip path)
+                  (.readAsText zip path)))
+              (.existsSync fs filename)
+              (node-read-file-sync filename))))))))
+
 (defn ^:export eval [in-str]
   (replumb/read-eval-call
-    (merge
-      {:no-pr-str-on-value true
-       :init-fn! replumbjs/init-fn!}
-      (replumb/options
-        :node
-        (make-load-fn
-          *load-paths*
-          (fn [filename source-cb]
-            (source-cb
-              (cond
-                (re-find #"\.jar/" filename)
-                (let [[jar-path path] (string/split filename ".jar/")
-                      zip (AdmZip. (str jar-path ".jar"))]
-                  (if (.getEntry zip path)
-                    (.readAsText zip path)))
-                (.existsSync fs filename)
-                (node-read-file-sync filename)))))))
+    (compile-options in-str)
     handle-result
     in-str))

@@ -229,7 +244,7 @@
   (cljsjs/compile-str
     replumbrepl/st
     in-str ""
-    (replumbrepl/base-eval-opts!)
+    (compile-options in-str)
     handle-result))

 (set! *main-cli-fn* (fn []))


Add client connection logging

Add client connection logging

--- src/copycat_jepsen/core.clj
+++ src/copycat_jepsen/core.clj
@@ -114,6 +114,7 @@
                     (debug node "Connection attempt failed. Retrying...")
                     (Thread/sleep 2000)
                     true)))
+      (debug node "Client connected!")
       (assoc this :register (figaro/dist-atom client "register"))))

   (invoke! [this test op]


Update tools-deps to 1.10.3.981

Update tools-deps to 1.10.3.981


Remove unused backpressure code.

Remove unused backpressure code.

--- src/onyx/messaging/netty_tcp.clj
+++ src/onyx/messaging/netty_tcp.clj
@@ -382,12 +382,6 @@
           (add-failed-check fut connection ^ByteBuf buf))
         (enqueue-pending connection buf))))

-<<<<<<< HEAD
-=======
-  (backpressure? [_]
-    (>= @incomplete-bytes 100000000))
-
->>>>>>> 423cf82... Many cumulative performance improvements in netty
   (close [_]
     (let [cval @channel] (if cval (.close ^Channel cval)))
     (some-> @pending-ch close!))