#!/bin/sh #_( true; exec clj -J-Xmx256M -J-XX:-OmitStackTraceInFastThrow -Sdeps "`sed -n -e '/;;(DEPS$/,/;;DEPS)$/p' $0`" -M -i $0 -e '(user/main)' ) (ns user #?(:cljs (:require-macros [user :as m])) (:require #?@(:clj ([cljs.build.api :as cljs] [clojure.java.io :as io] [clojure.repl :refer :all] [clojure.data :refer [diff]] [clojure.string :as str] [hiccup.core :refer [html]]) :cljs ([reagent.core :as r] [reagent.dom :as rdom] [clojure.string :as str])) [cognitect.transit :as transit] [com.stuartsierra.component :as component]) #?(:clj (:import (io.undertow.util Headers) (io.undertow.websockets.core AbstractReceiveListener WebSockets WebSocketChannel BufferedTextMessage) (io.undertow.websockets WebSocketProtocolHandshakeHandler WebSocketConnectionCallback) (io.undertow Undertow Handlers) (io.undertow.server HttpHandler HttpServerExchange) (java.io File) (java.nio ByteBuffer) (java.time Instant) (java.time.format DateTimeFormatter) (java.util.concurrent CompletableFuture)))) (comment ;;(DEPS {:deps {org.clojure/clojurescript {:mvn/version "1.10.879"} io.undertow/undertow-core {:mvn/version "2.2.12.Final"} reagent/reagent {:mvn/version "1.1.0"} cljsjs/react {:mvn/version "17.0.2-0"} cljsjs/react-dom {:mvn/version "17.0.2-0"} com.stuartsierra/component {:mvn/version "1.1.0"} com.cognitect/transit-clj {:mvn/version "1.0.324"} com.cognitect/transit-cljs {:mvn/version "0.8.269"}}} ;;DEPS) ) #?(:clj (do ;; (defrecord JavaFunction [f] ;; java.util.function.BiConsumer ;; (accept [_ a b] (f a b))) ;; (for [m (.getDeclaredMethods java.util.function.BiConsumer) ;; :when (java.lang.reflect.Modifier/isPublic (.getModifiers m)) ;; :when (java.lang.reflect.Modifier/isAbstract (.getModifiers m))] ;; (count (.getParameters m)) ;; #_`(~(symbol (.getName m)) ;; [] ;; )) (set! *warn-on-reflection* true) (defprotocol DoStuff :extend-via-metadata true (make-it-so! [_ f])) (extend-protocol DoStuff HttpServerExchange (make-it-so! [this f] (.dispatch this f))) (defn blocking [exchange f] (make-it-so! exchange (fn [] (.startBlocking exchange) (try (f) (finally (.endExchange exchange)))))) (defn undertow [m] (with-meta m {`make-it-so! (fn [this f] (.execute (.getWorker ^Undertow (:server this)) (bound-fn* f))) `component/start (fn [this] (if-not (:server this) (assoc this :server (doto (-> (Undertow/builder) (.setIoThreads (:io-threads this 1)) (.setWorkerThreads (:worker-threads this 5)) (.addHttpListener (:port this 80) (:ip this "0.0.0.0")) (.setHandler (:handler this)) (.build)) (.start))) this)) `component/stop (fn [this] (println "stopping undertow") (when (some? (:server this)) (.shutdownNow (.getWorker (:server this))) (.stop ^Undertow (:server this))) (println "stopped undertow") (dissoc this :server))})) (defonce this-file *file*) (defn compile-cljs* [] (prn `compile-cljs*) (let [js (File/createTempFile "whatever" ".js")] (try (cljs/build (.getAbsolutePath (io/file this-file)) {:output-to (.getAbsolutePath js) :optimizations :advanced}) (ByteBuffer/wrap (.toByteArray (doto (java.io.ByteArrayOutputStream.) ((fn [a] (clojure.java.io/copy js a)))))) (finally (.delete js))))) (defn compile-cljs-loop [server place run exit lm] (make-it-so! server (fn [] (try (if @run (let [n (.lastModified (clojure.java.io/file this-file))] (when (> n @lm) (let [cf (CompletableFuture.) old @place] (reset! place cf) (try (let [b (compile-cljs*)] (.complete ^CompletableFuture @place b) (.complete ^CompletableFuture old b)) (prn "cljs compilation complete") (catch Throwable t (.completeExceptionally ^CompletableFuture @place t)))) (reset! lm n)) (Thread/sleep 1000) (compile-cljs-loop server place run exit lm)) (exit true)) (catch Throwable t (prn t)))))) (defn compile-cljs [m] (with-meta m {`component/start (fn [this] (prn `compile-cljs `start) (if-not (:run this) (let [run (atom true) exit (promise) lm (atom 0)] (compile-cljs-loop (:server this) (:page this) run exit lm) (assoc this :run run :exit exit)) this)) `component/stop (fn [this] (println "stoppping compile-cljs") (when (some? (:run this)) (reset! (:run this) false)) (when (some? (:exit this)) @(:exit this)) (println "stopped compile-cljs") (dissoc this :run))})) (defrecord FnHandler [fun] HttpHandler (handleRequest [this exchange] (if-not (:blocking this) (fun this exchange) (blocking exchange (fn [] (fun this exchange)))))) (defn handlers-from-vars! [routing] (doseq [ns (all-ns) [n v] (ns-publics ns) :let [{:undertow/keys [routes blocking]} (meta v)] :when (seq routes) [method path] routes] (.add routing method path (assoc (->FnHandler v) :blocking blocking)))) (defn paths [m] (with-meta m {`component/start (fn [this] (let [p (:routes this)] (doseq [[k v] this :when (vector? k) :let [[method path] k]] (.add p method path v)) (handlers-from-vars! p)) this) `component/stop identity})) (defn query [query-string] (println query-string) (let [sql (.start (ProcessBuilder. ["psql" "-nq"]))] (with-open [sql-stream (.getOutputStream sql) sql-writer (io/writer sql-stream) results (.getInputStream sql) results-reader (io/reader results)] (binding [*out* sql-writer] (println "\\t") (println "\\a") (println "\\f '\\t'") (println query-string)) (.close sql-writer) (doall (for [line (line-seq results-reader)] (vec (.split line "\t"))))))) (defn lifts [] (sort (distinct (map #(nth % 2) (query "select * from weight_training.log order by at desc, lift"))))) (defn list-lifts {:undertow/routes [["get" "/lifts"]] :undertow/blocking true} [_ exchange] (-> exchange .getResponseHeaders (.put Headers/CONTENT_TYPE "application/json")) (with-open [i (.getInputStream exchange) o (.getOutputStream exchange)] (transit/write (transit/writer o :json) (lifts)))) (defn lift-log {:undertow/routes [["get" "/lift-log"]] :undertow/blocking true} [_ exchange] (-> exchange .getResponseHeaders (.put Headers/CONTENT_TYPE "application/transit")) (with-open [i (.getInputStream exchange) o (.getOutputStream exchange)] (let [lift (some #{(some-> (.getQueryParameters exchange) (get "lift") (first))} (lifts)) limit (or (some-> (.getQueryParameters exchange) (get "limit") (first) (parse-long)) 10) offset (or (some-> (.getQueryParameters exchange) (get "offset") (first) (parse-long)) 0)] (if lift (let [rows (query (format "select * from weight_training.log where lift = '%s' order by at desc, lift limit %s offset %s" lift limit offset))] (transit/write (transit/writer o :json) rows)) (let [rows (query (format "select * from weight_training.log order by at desc, lift limit %s offset %s" limit offset))] (transit/write (transit/writer o :json) rows)))))) (defn index-page-get {:undertow/routes [["get" "/"]]} [_ exchange] (let [[prefix] (.get (.getRequestHeaders exchange) "X-Prefix")] (try (doto exchange (-> .getResponseHeaders (.put Headers/CONTENT_TYPE "text/html")) (-> .getResponseSender (.send (format "
" (or prefix "") (or prefix "")) io.undertow.io.IoCallback/END_EXCHANGE))) (catch Throwable t (prn t))))) (defn index-page-post {:undertow/routes [["post" "/"]] :undertow/blocking true} [_ exchange] (prn `index-page) (prn (.getQueryParameters exchange)) (let [[prefix] (.get (.getRequestHeaders exchange) "X-Prefix") form-data (-> (io.undertow.server.handlers.form.FormParserFactory/builder) (.build) (.createParser exchange) (.parseBlocking)) lift (some #{(some-> form-data (.get "lift") (first) (.getValue))} (lifts)) set-count (some-> form-data (.get "set") (first) (.getValue) (parse-long)) rep (some-> form-data (.get "rep") (first) (.getValue) (parse-long)) weight (some-> form-data (.get "weight") (first) (.getValue) (parse-long))] (query (format "insert into weight_training.log (lift, weight, set, rep, at) values ('%s', %s, %s, %s,NOW())" lift weight set-count rep)))) (def system) (defn add-deps [system name new-deps] (assoc system name (component/using (get system name) (merge (component/dependencies (get system name)) new-deps)))) (defn main [] (try (let [s (component/start (component/system-using (component/system-map :routes (io.undertow.Handlers/routing) :paths (paths {}) :js (compile-cljs {}) :page (atom (CompletableFuture.)) :undertow (undertow {:port 5636 :ip "::"}) :js-page (->FnHandler (fn [this exchange] (try (.dispatch exchange (fn [] (.whenCompleteAsync @(:page this) (reify java.util.function.BiConsumer (accept [_ t u] (let [^ByteBuffer t t] (prn "serving js" t) (when u (prn u)) (doto exchange (-> .getResponseHeaders (.put Headers/CONTENT_TYPE "application/javascript")) (-> .getResponseSender (.send (.slice t) io.undertow.io.IoCallback/END_EXCHANGE)))))) ;; io thread is not correct here (.getIoThread exchange)))) (catch Throwable t (prn t))))) :shutdown (promise)) {:undertow {:handler :routes :foo :paths} :js {:page :page :server :undertow} :js-page [:page] :paths {["get" "/app.js"] :js-page :routes :routes}}))] (alter-var-root #'system (constantly s)) (future (clojure.main/repl)) (let [code (deref (:shutdown s))] (component/stop s) (System/exit code))) (catch Throwable t (prn t) (System/exit -1)))) ) :cljs (do (defn g [weight] (first (for [percentile25 (range 2) percentile50 (range 2) percentile75 (range 2) p1 (range 2) p5 (range 2) p10 (range 3) p25 (range 2) p45 (range 6) ;; 2.5 :let [x (+ 45 (* 2 (+ (* percentile25 (/ 1 4)) (* percentile50 (/ 1 2)) (* percentile75 (/ 3 4)) (* p1 1) (* p5 5) (* p10 10) (* p25 25) (* p45 45))))] :when (== weight x)] [percentile25 percentile50 percentile75 p1 p5 p10 p25 p45]))) (defn fetch-transit [url] (-> (js/fetch url) (.then (fn [result] (.text result))) (.then #(transit/read (transit/reader :json) %)))) (defn fetch-lift-log ([prefix] (fetch-transit (str prefix "/lift-log"))) ([prefix lift] (fetch-transit (str prefix "/lift-log?lift=" lift)))) (defn select-lifts [state prefix] [:dl [:dt "Lift"] [:dd [:select {:name "lift" :on-change (fn [evt] (let [lift (.-value (.-target evt))] (when (= lift "