working on heads up display

working on heads up display

error: pathspec 'example/src/example/client.cljs' did not match any file(s) known to git

--- example/src/example/client.cljs
+++ example/src/example/client.cljs
@@ -0,0 +1,359 @@
+(ns example.client
+  (:require
+   [goog.Uri :as guri]
+   [goog.net.jsloader :as loader]
+   [cljs.reader :refer [read-string]]
+   [cljs.core.async :refer [put! chan <! map< close! timeout alts!] :as async]
+   [clojure.string :as string])
+  (:require-macros
+   [cljs.core.async.macros :refer [go go-loop]]
+   [figwheel.client :refer [defonce]]))
+
+
+(defn log [{:keys [debug]} & args]
+  (when debug
+    (.log js/console (to-array args))))
+
+(defn reload-host [{:keys [websocket-url]}]
+  (-> websocket-url
+      (string/replace-first #"^wss?:" "")
+      (string/replace-first #"^//" "")
+      (string/split #"/")
+      first))
+
+;; this assumes no query string on url
+(defn add-cache-buster [url]
+  (.makeUnique (guri/parse url)))
+
+(defn js-reload [{:keys [request-url namespace dependency-file] :as msg} callback]
+  (if (or dependency-file
+            ;; IMPORTANT make sure this file is currently provided
+          (.isProvided_ js/goog namespace))
+    (.addCallback (loader/load (add-cache-buster request-url))
+                  #(apply callback [msg]))
+    (apply callback [msg])))
+
+(defn reload-js-file [file-msg]
+  (let [out (chan)]
+    (js-reload file-msg (fn [url] (put! out url) (close! out)))
+    out))
+
+(defn load-all-js-files [files]
+  "Returns a chanel with one collection of loaded filenames on it."
+  (async/into [] (async/filter< identity (async/merge (mapv reload-js-file files)))))
+
+(defn add-request-url [{:keys [url-rewriter] :as opts} {:keys [file] :as d}]
+  (->> file
+       (str "//" (reload-host opts))
+       url-rewriter
+       (assoc d :request-url)))
+
+(defn add-request-urls [opts files]
+  (map (partial add-request-url opts) files))
+
+(defn reload-js-files [{:keys [before-jsload on-jsload] :as opts} last-message-type {:keys [files] :as msg}]
+  (if (or (:load-warninged-code opts)
+          (not= last-message-type :compile-warning))
+    (go
+     (before-jsload files)
+     (let [files'  (add-request-urls opts files)
+           res     (<! (load-all-js-files files'))]
+       (when (not-empty res)
+         (.debug js/console "Figwheel: loaded these files")
+         (.log js/console (pr-str (map :file res)))
+         (<! (timeout 10)) ;; wait a beat before callback
+         (apply on-jsload [res]))))
+    (go
+     (.warn js/console "Figwheel: Not loading code with warnings - " (-> msg :files first :file))
+     0)))
+
+;; CSS reloading
+
+(defn current-links []
+  (.call (.. js/Array -prototype -slice) (.query js/document "link")))
+
+(defn truncate-url [url]
+  (-> (first (string/split url #"\?"))
+      (string/replace-first (str (.-protocol js/location) "//") "")
+      (string/replace-first "http://" "")
+      (string/replace-first "https://" "")
+      (string/replace-first #"^//" "")
+      (string/replace-first #"[^\/]*" "")))
+
+(defn matches-file? [{:keys [file request-url]} link-href]
+  (let [trunc-href (truncate-url link-href)]
+    (or (= file trunc-href)
+        (= (truncate-url request-url) trunc-href))))
+
+(defn get-correct-link [f-data]
+  (some (fn [l]
+          (when (matches-file? f-data (.-href l)) l))
+        (current-links)))
+
+(defn clone-link [link url]
+  (let [clone (.createElement js/document "link")]
+    (set! (.-rel clone)      "stylesheet")
+    (set! (.-media clone)    (.-media link))
+    (set! (.-disabled clone) (.-disabled link))
+    (set! (.-href clone)     (add-cache-buster url))
+    clone))
+
+(defn create-link [url]
+  (let [link (.createElement js/document "link")]
+    (set! (.-rel link)      "stylesheet")
+    (set! (.-href link)     (add-cache-buster url))
+    link))
+
+(defn add-link-to-doc
+  ([new-link]
+     (.appendChild (aget (.getElementsByTagName js/document "head") 0)
+                   new-link))
+  ([orig-link klone]
+     (let [parent (.-parentNode orig-link)]
+       (if (= orig-link (.-lastChild parent))
+         (.appendChild parent klone)
+         (.insertBefore parent klone (.-nextSibling orig-link)))
+       (go
+        (<! (timeout 200))
+        (.removeChild parent orig-link)))))
+
+(defn reload-css-file [{:keys [file request-url] :as f-data}]
+  (if-let [link (get-correct-link f-data)]
+    (add-link-to-doc link (clone-link link request-url))
+    (add-link-to-doc (create-link request-url))))
+
+(defn reload-css-files [{:keys [on-cssload] :as opts} files-msg]
+  (doseq [f (add-request-urls opts (:files files-msg))]
+    (reload-css-file f))
+  (go
+   (<! (timeout 100))
+   (on-cssload (:files files-msg))))
+
+;; heads up display
+
+;; cheap hiccup
+(defn node [t attrs & children]
+     (let [e (.createElement js/document (name t))]
+       (doseq [k (keys attrs)] (.setAttribute e (name k) (get attrs k)))
+       (doseq [ch children] (.appendChild e ch)) ;; children
+       e))
+
+(defn ensure-container [id]
+  (if-not (.querySelector js/document (str "#" id))
+    (-> (.getElementsByTagName js/document "body")
+        (aget 0)
+        (.appendChild (node :div { :id id
+                                    :style
+                                    (str "-webkit-transition: all 0.2s ease-in-out;"
+                                         "-moz-transition: all 0.2s ease-in-out;"
+                                         "-o-transition: all 0.2s ease-in-out;"
+                                         "transition: all 0.2s ease-in-out;"
+                                         "font-size: 14px;"
+                                         "line-height: 18px;"
+                                         "text-align: center;"
+                                         "color: white;"
+                                         "font-family: monospace;"
+                                         "padding: 0px 30px;"
+                                         "position: fixed;"
+                                         "bottom: 0px;"
+                                         "right: 0px;"
+                                         "left: 0px;"
+                                         "height: 0px;"
+                                         "opacity: 0.0;"
+                                         ) })))
+    (.getElementById js/document id)))
+
+(defn set-style [c st-map]
+  (mapv
+   (fn [[k v]]
+     (aset (.-style c) (name k) v))
+   st-map))
+
+(defn display-heads-up [style msg]
+  (go
+   (let [c (ensure-container "figwheel-heads-up-container")]
+     (set! (.-innerHTML c ) msg)
+     (set-style c (merge {
+                          :paddingTop "10px"
+                          :paddingBottom "10px"
+                          :height "auto"
+                          :opacity "1.0" }
+                         style))
+     (<! (timeout 400)))))
+
+(defn display-error [msg]
+  (display-heads-up {:backgroundColor "rgba(204,50,30, 0.95)"} msg))
+
+(defn display-warning [msg]
+  (display-heads-up {:backgroundColor "rgba(231, 154, 0, 0.95)" } msg))
+
+(defn heads-up-append-message [message]
+  (let [c (ensure-container "figwheel-heads-up-container")]
+     (set! (.-innerHTML c ) (str (.-innerHTML c) "
" message))))
+
+(defn clear-heads-up []
+  (go
+   (let [c (ensure-container "figwheel-heads-up-container")]
+     (set-style c { :opacity "0.0" })
+     (<! (timeout 200))
+     (set! (.-innerHTML c ) "")
+     (set-style c { :height "0px"
+                    :backgroundColor "transparent" }))))
+
+(ensure-container "figwheel-heads-up-container")
+#_(warning-circle "This is an error yeppers")
+
+;; super tricky hack to get goog to load newly required files
+
+(defn figwheel-closure-import-script [src]
+  (if (.inHtmlDocument_ js/goog)
+    (do
+      #_(.log js/console "Figwheel: latently loading required file " src )
+      (loader/load (add-cache-buster src))
+      true)
+    false))
+
+(defn patch-goog-base []
+  (set! (.-provide js/goog) (.-exportPath_ js/goog))
+  (set! (.-CLOSURE_IMPORT_SCRIPT (.-global js/goog)) figwheel-closure-import-script))
+
+(defn have-websockets? [] (js*  "(\"WebSocket\" in window)"))
+(defn have-custom-events? [] (js*  "(\"CustomEvent\" in window)"))
+
+;; handle messages coming over the WebSocket
+;; messages have the following formats
+
+;; files-changed message
+;; { :msg-name :files-changed
+;;   :files    [{:file "/js/compiled/out/example/core.js",
+;;               :type :javascript,
+;;               :msg-name :file-changed,
+;;               :namespace "example.core" }] }
+
+;; css-files-changed message
+;; there should really only be one file in here at a time
+;; { :msg-name :css-files-changed
+;;   :files    [{:file "/css/example.css",
+;;               :type :css }] }
+
+;; compile-failed message
+;; { :msg-name :compile-failed
+;;   :exception-data {:cause { ... lots of exception info ... } }}
+;; the exception data is nested raw info obtained for the compile time
+;; exception
+
+(defn watch-and-reload* [{:keys [retry-count websocket-url] :as opts}
+                         msg-channel]
+  (if-not (have-websockets?)
+    (.debug js/console "Figwheel: Can't start Figwheel!! This browser doesn't support WebSockets")
+    (do
+      (.debug js/console "Figwheel: trying to open cljs reload socket")
+      (let [socket (js/WebSocket. websocket-url)]
+        (set! (.-onmessage socket) (fn [msg-str]
+                                     (when-let [msg (read-string (.-data msg-str))]
+                                       #_(.log js/console (pr-str msg))
+                                       (and (map? msg)
+                                            (:msg-name msg)
+                                            (not= (:msg-name msg) :ping)
+                                            (put! msg-channel msg)))))
+        (set! (.-onopen socket)  (fn [x]
+                                   (patch-goog-base)
+                                   (.debug js/console "Figwheel: socket connection established")))
+        (set! (.-onclose socket) (fn [x]
+                                   (log opts "Figwheel: socket closed or failed to open")
+                                   (when (> retry-count 0)
+                                     (.setTimeout js/window
+                                                  (fn []
+                                                    (watch-and-reload*
+                                                     (assoc opts :retry-count (dec retry-count))
+                                                     msg-channel))
+                                                  2000))))
+        (set! (.-onerror socket) (fn [x] (log opts "Figwheel: socket error ")))
+        socket))))
+
+(defn default-on-jsload [url]
+  (when (have-custom-events?)
+    (.dispatchEvent (.querySelector js/document "body")
+                    (js/CustomEvent. "figwheel.js-reload"
+                                     (js-obj "detail" url)))))
+
+(defn get-essential-messages [ed]
+  (when ed
+    (cons (select-keys ed [:message :class])
+          (get-essential-messages (:cause ed)))))
+
+(defn error-msg-format [{:keys [message class]}] (str class " : " message))
+
+(def format-messages (comp (partial map error-msg-format) get-essential-messages))
+
+(defn default-on-compile-fail [{:keys [formatted-exception exception-data] :as ed}]
+  (.debug js/console "Figwheel: Compile Exception")
+  (doseq [msg (format-messages exception-data)]
+    (.log js/console msg))
+  ed)
+
+;; compile failure behavior
+
+(defn compile-failed [opts
+                      {:keys [formatted-exception exception-data] :as fail-msg}
+                      compile-fail-callback]
+  (compile-fail-callback (dissoc fail-msg :msg-name))
+  (display-error (clojure.string/join "
" (format-messages exception-data))))
+
+(defn compile-warning [{:keys [on-compile-warning]} last-message-type
+                       {:keys [message] :as msg}]
+  (on-compile-warning msg)
+  (if (= last-message-type :compile-warning)
+    (go (heads-up-append-message message) 1)
+    (display-warning message)))
+
+(defn default-on-compile-warning [{:keys [message] :as w}]
+  (.warn js/console "Figwheel: Compile Warning -" message)
+  w)
+
+(defn default-before-load [files]
+  (.debug js/console "Figwheel: loading files")
+  #_(.log js/console (pr-str (mapv :file files)))
+  files)
+
+(defn default-on-cssload [files]
+  (.debug js/console "Figwheel: loaded CSS files")
+  (.log js/console (pr-str (map :file files)))
+  files)
+
+(defn message-handler-loop [msg-channel {:keys [on-compile-warning on-compile-fail] :as opts}]
+  (go-loop [last-message-type ::not-a-known-message]
+           (let [msg (<! msg-channel)]
+             (when msg
+               (when (and (not= :compile-warning last-message-type)
+                          (= (:msg-name msg) :files-changed))
+                 (<! (clear-heads-up)))
+               (condp = (:msg-name msg)
+                 :files-changed     (<! (reload-js-files opts last-message-type msg) )
+                 :css-files-changed (reload-css-files opts msg)
+                 :compile-failed    (<! (compile-failed opts msg on-compile-fail))
+                 :compile-warning   (<! (compile-warning opts last-message-type msg))
+                 nil)
+               (recur (:msg-name msg))))))
+
+(defn watch-and-reload-with-opts [opts]
+  (defonce watch-and-reload-singleton
+    (let [msg-channel (chan)]
+      (let [config (merge { :retry-count 100
+                           :jsload-callback default-on-jsload ;; *** deprecated
+                           :on-jsload (or (:jsload-callback opts) default-on-jsload)
+                           :on-cssload default-on-cssload
+                           :before-jsload default-before-load
+                           :on-compile-fail default-on-compile-fail
+                           :on-compile-warning default-on-compile-warning
+                           :url-rewriter identity
+                           :websocket-url (str "ws://" js/location.host "/figwheel-ws")
+                           :load-warninged-code false}
+                          opts)]
+        (watch-and-reload* config msg-channel)
+        (message-handler-loop msg-channel config)))))
+
+;; This takes keyword arguments
+(defn watch-and-reload
+  [& {:keys [] :as opts}]
+  (watch-and-reload-with-opts opts))


determine autopay for a member license

determine autopay for a member license

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/starcity-properties/odin.git/'


Chapter 7, figure 3

Chapter 7, figure 3

error: pathspec 'src/vdquil/chapter7/fig3-subfolder-treemap.clj' did not match any file(s) known to git

--- src/vdquil/chapter7/fig3-subfolder-treemap.clj
+++ src/vdquil/chapter7/fig3-subfolder-treemap.clj
@@ -0,0 +1,63 @@
+;; Ben Fry's Visualizing Data, Chapter 7, figure 7-3
+;; Visualize a filesystem as a treemap
+;; Converted from Processing to Clojure as an exercise by Dave Liepmann
+
+;; project.clj's :java-source-paths gives us access to treemap
+;; Treemap package grabbed from http://benfry.com/writing/treemap/library.zip
+(ns vdquil.chapter7.fig3-subfolder-treemap
+  (:use quil.core)
+  (:import treemap.SimpleMapItem treemap.Treemap treemap.SimpleMapModel)
+  (:require [clojure.string :as string]))
+
+(def root (clojure.java.io/file "/Users/daveliepmann/src/vdquil"))
+
+;; I found it handy to preview what I'm going to map:
+;; (doseq [l (.listFiles root)]
+;;   (println [(.getName l) (.length l)]))
+
+;; ...this gets used in place of (.listFiles root) when mapping file-item to that sexp.
+;; (def dummy [["_CodeSignature" 102]
+;;             ["Info.plist" 3710]
+;;             ["MacOS" 102]
+;;             ["PkgInfo" 8]
+;;             ["Resources" 170]])
+
+;; I repurposed word-item from simple-treemap-example instead of
+;; building an entirely new file-item and folder-item.
+(defn file-item
+  "Returns a `file-item` object extending `SimpleMapItem`."
+  [file]
+  (doto (proxy [SimpleMapItem] []
+          (draw []
+            (fill 255)
+            (rect (.x this) (.y this) (.w this) (.h this))
+            (text-align :center :center)
+            (fill 0)
+            (let [name (.getName file)]
+              (when (and (> (.w this) (+ 6 (text-width name)))
+                         (> (.w this) (+ 6 (text-ascent))))
+                (text-align :center :center)
+                (fill 0)
+                (text name
+                      (+ (.x this) (/ (.w this) 2))
+                      (+ (.y this) (/ (.h this) 2)))))))
+    (.setSize (.length file))))
+
+(defn setup []
+  (smooth)
+  (stroke-weight 0.1)
+  (text-font (create-font "Sans-Serif" 13))
+  (no-loop))
+
+(defn draw []
+  (background 255)
+  (let [folder-map (doto (SimpleMapModel.)
+                     (.setItems (into-array treemap.SimpleMapItem
+                                            (map file-item (.listFiles root)))))]
+    (.draw (Treemap. folder-map 0 0 (width) (height)))))
+
+(defsketch fig7-3
+  :title "Figure 7-3. Treemap depicting relative sizes of subfolders"
+  :draw draw
+  :setup setup
+  :size [1024 768])


Animated pulse

Animated pulse

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/dominikzarzecki/meteor-impacts-timelapse.git/'


Add dom helpers by-tag-name and events-as-chan

error: pathspec 'src/lo_cash/dom.cljs' did not match any file(s) known to git

--- src/lo_cash/dom.cljs
+++ src/lo_cash/dom.cljs
@@ -0,0 +1,17 @@
+(ns lo-cash.dom
+  (:require [goog.events :as events]
+            [goog.dom :as gdom]
+            [cljs.core.async :as async :refer [chan]]))
+
+(defn by-tag-name
+  "Gets all elements by tag name, either inside a DOM node or globally"
+  ([tag-name (get-by-tag-name tag-name nil)])
+  ([tag-name node] (array-seq (gdom/getElementsByTagNameAndClass tag-name nil node))))
+
+(defn events-as-chan
+  "Creates a channel that emits event objects of the types fired from the DOM node"
+  [node & ev-types]
+  (let [c (chan)]
+    (dorun (for [type types]
+             (events/listen el type #(put! c %))))
+    c))


change plan-name

change plan-name


Fix failing test

Fix failing test

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/aaronlahey/coconut.git/'


Cosmetic change to pepa.config

Cosmetic change to pepa.config

--- src/pepa/config.clj
+++ src/pepa/config.clj
@@ -4,10 +4,9 @@
 (defrecord Config []
   component/Lifecycle
   (start [component]
-    (into component (let [file (or (System/getenv "PEPA_CONFIG")
-                                   "config.clj")]
-                      (load-file file))))
-
+    (let [file (or (System/getenv "PEPA_CONFIG") "config.clj")
+          settings (load-file file)]
+      (into component settings)))
   (stop [component]
     (->Config)))


add useful.bean from ninjudd/clojure.contrib.bean

error: pathspec 'src/useful/bean.clj' did not match any file(s) known to git

--- src/useful/bean.clj
+++ src/useful/bean.clj
@@ -0,0 +1,39 @@
+(ns
+    #^{:author "Justin Balthrop"
+       :doc "Modify bean attributes in clojure."}
+  useful.bean
+  (:import [java.beans Introspector]))
+
+(defn- property-key [property]
+  (keyword (.. (re-matcher #"\B([A-Z])" (.getName property))
+               (replaceAll "-$1")
+               toLowerCase)))
+
+(defn property-setters
+  "Returns a map of keywords to property setter methods for a given class."
+  [class]
+  (reduce
+   (fn [map property]
+     (assoc map (property-key property) (.getWriteMethod property)))
+   {} (.getPropertyDescriptors (Introspector/getBeanInfo class))))
+
+(defmulti coerce (fn [bean-class type val] [type (class val)]))
+(defmethod coerce :default [_ type val]
+  (if (= String type)
+    (str val)
+    (try (cast type val)
+         (catch ClassCastException e
+           val))))
+
+(defn update-bean
+  "Update the given bean instance with attrs by calling the appropriate setter methods on it."
+  [instance attrs]
+  (let [bean-class (class instance)
+        setters    (property-setters bean-class)]
+    (doseq [[key val] attrs]
+      (if-let [setter (setters key)]
+        (when-not (nil? val)
+          (let [type (first (.getParameterTypes setter))]
+            (.invoke setter instance (into-array [(coerce bean-class type val)]))))
+        (throw (Exception. (str "property not found for " key)))))
+    instance))


Fix to nextval

Fix to nextval

--- examples/phonebook/src/phonebook/resource_types.clj
+++ examples/phonebook/src/phonebook/resource_types.clj
@@ -38,14 +38,13 @@

   m/Post
   (POST [_ ctx]
-    (dosync
-     (let [{:strs [surname firstname phone]} (get-in ctx [:parameters :form])
-           nextval (db/add-entry db {:surname surname
-                                     :firstname firstname
-                                     :phone phone})]
+    (let [{:strs [surname firstname phone]} (get-in ctx [:parameters :form])
+          id (db/add-entry db {:surname surname
+                               :firstname firstname
+                               :phone phone})]

-       (yada/redirect-after-post
-        ctx (path-for @*routes :phonebook.api/entry :entry nextval))))))
+      (yada/redirect-after-post
+       ctx (path-for @*routes :phonebook.api/entry :entry id)))))

 (defn new-index-resource [db *routes]
   (->IndexResource db *routes))


Refactoring to use base conversion utils

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/xcthulhu/clj-bitauth.git/'


Use #js syntax again in wrap-form-element

--- src/sablono/interpreter.cljc
+++ src/sablono/interpreter.cljc
@@ -14,36 +14,35 @@
    (defn wrap-form-element [ctor display-name]
      (js/React.createFactory
       (js/React.createClass
-       (clj->js
-        {:getDisplayName
-         (fn [] (name display-name))
-         :getInitialState
-         (fn []
-           (this-as this
-             (clj->js {:value (aget (.-props this) "value")})))
-         :onChange
-         (fn [e]
-           (this-as this
-             (let [handler (aget (.-props this) "onChange")]
-               (when-not (nil? handler)
-                 (handler e)
-                 (.setState this (clj->js {:value (.. e -target -value)}))))))
-         :componentWillReceiveProps
-         (fn [new-props]
-           (this-as this
-             (.setState this (clj->js {:value (aget new-props "value")}))))
-         :render
-         (fn []
-           (this-as this
-             ;; NOTE: if switch to macro we remove a closure allocation
-             (let [props (clj->js {})]
-               (gobject/extend
-                   props (.-props this)
-                   (clj->js
-                    {:value (aget (.-state this) "value")
-                     :onChange (aget this "onChange")
-                     :children (aget (.-props this) "children")}))
-               (ctor props))))})))))
+       #js
+       {:getDisplayName
+        (fn [] (name display-name))
+        :getInitialState
+        (fn []
+          (this-as this
+            #js {:value (aget (.-props this) "value")}))
+        :onChange
+        (fn [e]
+          (this-as this
+            (let [handler (aget (.-props this) "onChange")]
+              (when-not (nil? handler)
+                (handler e)
+                (.setState this #js {:value (.. e -target -value)})))))
+        :componentWillReceiveProps
+        (fn [new-props]
+          (this-as this
+            (.setState this #js {:value (aget new-props "value")})))
+        :render
+        (fn []
+          (this-as this
+            ;; NOTE: if switch to macro we remove a closure allocation
+            (let [props #js {}]
+              (gobject/extend
+                  props (.-props this)
+                  #js {:value (aget (.-state this) "value")
+                       :onChange (aget this "onChange")
+                       :children (aget (.-props this) "children")})
+              (ctor props))))}))))

 #?(:cljs (def input (wrap-form-element js/React.DOM.input "input")))
 #?(:cljs (def option (wrap-form-element js/React.DOM.option "option")))


datastore.clj: added first draft of persisting refs to s3

error: pathspec 'src/org/altlaw/db/datastore.clj' did not match any file(s) known to git

--- src/org/altlaw/db/datastore.clj
+++ src/org/altlaw/db/datastore.clj
@@ -0,0 +1,25 @@
+(ns org.altlaw.db.datastore
+  (:require [org.altlaw.util.s3 :as s3]))
+
+(def *bucket* "content.altlaw.org")
+
+(defn make-path [path]
+  (str "datastore/" path))
+
+(def get-data
+     (memoize (fn [path]
+                (ref
+                 (read-string
+                  (s3/get-object-string
+                   *bucket* (make-path path)))))))
+
+(defn save-data [path]
+  (let [ref (get-data path)]
+    (s3/put-object-gzip-string
+     *bucket* (make-path path)
+     (pr-str @ref) {"Content-Type" "application/clojure"})))
+
+(defn create-data [path]
+  (s3/put-object-gzip-string
+   *bucket* (make-path path)
+   "nil" {"Content-Type" "application/clojure"}))


more notes

more notes

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/michaelsbradleyjr/transwarp.git/'


require clojure.walk for macroexpand-all func


implement draggable behavior of morphs

implement draggable behavior of morphs

error: pathspec 'src-cljs/cljs_workspace/om_draggable.cljs' did not match any file(s) known to git

--- src-cljs/cljs_workspace/om_draggable.cljs
+++ src-cljs/cljs_workspace/om_draggable.cljs
@@ -0,0 +1,60 @@
+(ns cljs-workspace.draggable
+  (:require-macros [cljs.core.async.macros :refer [go]])
+  (:require [goog.events :as events]
+            [goog.events.EventType :as EventType]
+            [cljs.core.async :as async :refer [>! <! put! chan]]
+            [om.core :as om :include-macros true]
+            [om.dom :as dom :include-macros true]
+            [goog.style :as gstyle]
+
+            ; [clojure.browser.repl :as repl]
+            )
+  (:import [goog.events EventType]))
+
+(def clicked-morph
+  (atom nil))
+
+(def prev-cursor-pos
+  (atom [0 0]))
+
+;; draggin functions
+
+(declare shape)
+(declare render-submorphs)
+
+(defn listen [el type]
+  (let [out (chan)]
+    (events/listen el type #(put! out %))
+    out))
+
+(defn element-offset [el]
+  (let [offset (gstyle/getPageOffset el)]
+    [(.-x offset) (.-y offset)]))
+
+(defn location [e]
+  [(.-clientX e) (.-clientY e)])
+
+(defn drag [e app offset]
+  (let [old-pos (get-in @app [:morph :Position])
+        [prev-cursor-x, prev-cursor-y] @prev-cursor-pos
+        [delta-x, delta-y] [(- (.-clientX e) prev-cursor-x) (- (.-clientY e) prev-cursor-y)]
+        [new-pos-x, new-pos-y] [(+ (old-pos :x) delta-x) (+ (old-pos :y) delta-y)]]
+    (when (= (@app :id) @clicked-morph)
+      (swap! prev-cursor-pos #(identity [(.-clientX e) (.-clientY e)]))
+      (om/update! app [:morph :Position] {:x new-pos-x :y new-pos-y}))))
+
+(defn stop-dragging [e app]
+  (swap! clicked-morph #(identity nil))
+  (doto js/window
+      (events/unlisten EventType.MOUSEUP stop-dragging)
+      (events/unlisten EventType.MOUSEMOVE #(drag % app nil)))) ;; let the event propagate further down ??
+
+(defn start-dragging [e app owner]
+  (swap! prev-cursor-pos #(identity [(.-clientX e) (.-clientY e)]))
+  (when (not @clicked-morph) (swap! clicked-morph #(@app :id)))
+    ;; start listening for mouse movements in the window in case the mouse cursor
+    ;; escapes temporarily from the dragged morph
+    (let [[offset-x, offset-y] (element-offset (om/get-node owner))]
+      (doto js/window
+        (events/listen EventType.MOUSEUP stop-dragging)
+        (events/listen EventType.MOUSEMOVE #(drag % app [offset-x offset-y]))))) ;; let the event propagate further down


First pass at playing with explicit properties

error: pathspec 'src/simple_check/properties.clj' did not match any file(s) known to git

--- src/simple_check/properties.clj
+++ src/simple_check/properties.clj
@@ -0,0 +1,18 @@
+(ns simple-check.properties
+  (:require [simple-check.generators :as gen]))
+
+(defn apply-gen
+  [function]
+  (fn [args]
+    (fn [random-seed size]
+      ;; since we need to capture the arguments for shrinking and reporting
+      ;; purposes, perhaps here is were we could do that. Return a single-run
+      ;; `result` map that contains something like:
+      ;; {:pass true
+      ;;  :args [0 false]}
+      (apply function args))))
+
+(defn forall
+  [args function]
+  (gen/bind (gen/tuple args)
+            (apply-gen function)))