#!/bin/sh #_( true; exec clj -J--enable-preview -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] [clojure.java.shell :as sh]) :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) (java.util.concurrent Executors Executor)))) (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"} io.github.classgraph/classgraph {:mvn/version "LATEST"}}} ;;DEPS) ) #?(:clj (do (defmulti java-fn (fn [klass f] klass)) (let [scan-results (-> (io.github.classgraph.ClassGraph.) ;; (.verbose) (.enableAllInfo) (.enableSystemJarsAndModules) (.acceptPackages (into-array String ["java.util.function"])) (.scan))] (doseq [info (.getAllInterfaces scan-results) :let [klass (.loadClass info)]] (eval `(import ~(symbol (.getName klass)))) (.addMethod java-fn klass (eval `(fn [~'_ ~'f] (reify ~(symbol (.getName info)) ~@(for [m (.getDeclaredMethods klass) :when (java.lang.reflect.Modifier/isPublic (.getModifiers m)) :when (java.lang.reflect.Modifier/isAbstract (.getModifiers m)) :let [argv (count (.getParameters m)) args (repeatedly argv gensym)]] `(~(symbol (.getName m)) [~'this ~@args] (~'f ~@args))))))))) (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))) (extend-protocol DoStuff Executor (make-it-so! [this f] (.execute this f))) (defn blocking [do-stuff exchange f] (make-it-so! do-stuff (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 :output-dir "/tmp/out"}) (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 exchange (fn [] (fun this exchange)))))) (defn handlers-from-vars! [routing pool] (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 :pool pool)))) (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 (assoc v :pool (:pool this)))) (handlers-from-vars! p (:pool this))) this) `component/stop identity})) (defn press-post {:undertow/routes [["post" "/press"]] :undertow/blocking true} [_ exchange] (-> exchange .getResponseHeaders (.put Headers/CONTENT_TYPE "text/plain")) (with-open [i (.getInputStream exchange) o (.getOutputStream exchange)] (let [button (some-> (.getQueryParameters exchange) (get "button") (first))] (case button "ON" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "ON") "OFF" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "OFF") "HIGH" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "FAN_HIGH") "LOW" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "FAN_LOW") "MEDIUM" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "FAN_MEDIUM") "61°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_61") "62°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_62") "63°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_63") "64°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_64") "65°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_65") "66°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_66") "67°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_67") "68°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_68") "69°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_69") "70°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_70") "71°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_71") "72°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_72") "73°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_73") "74°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_74") "75°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_75") "76°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_77") "77°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_77") "78°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_78") "79°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_79") "80°" (sh/sh "mosquitto_pub" "-t" "ac_commands" "-h" "mqtt.home.arpa" "-p" "1883" "-m" "TEMP_80")) (.write o (.getBytes "Ok\n"))))) (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 "<meta charset=\"utf-8\" /> <!DOCTYPE html> <html> <head> <script src=\"%s/app.js\"></script> </head> <body> <script>user.main(\"%s\");</script> </body> </html> " (or prefix "") (or prefix "")) io.undertow.io.IoCallback/END_EXCHANGE))) (catch Throwable t (prn t))))) (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 [] (when (System/getenv "DRYRUN") (System/exit 0)) (try (let [s (component/start (component/system-using (component/system-map :pool (Executors/newVirtualThreadPerTaskExecutor) :routes (io.undertow.Handlers/routing) :paths (paths {}) :js (compile-cljs {}) :page (atom (CompletableFuture.)) :undertow (undertow {:port 5637}) :js-page (->FnHandler (fn [this exchange] (try (.dispatch exchange (fn [] (.whenCompleteAsync @(:page this) (java-fn BiConsumer (fn [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 :pool :pool :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 ^:export main [prefix] (set! (.-title js/document) "Whynter AC Remote") (doto (aget js/document "head") (.appendChild (doto (.createElement js/document "link") (.setAttribute "href" "https://downey.family/~kevin/tufte.min.css") (.setAttribute "rel" "stylesheet")))) (rdom/render [(fn [] [:div [:h1 "Whynter AC Remote"] [:table [:tr [:td [:button {:on-click (fn [] (js/fetch (str "/press?button=ON") (doto (object-array 0) (aset "method" "POST"))) (-> js/window (.-navigator) (.vibrate 200)))} [:div {:style {:font-size "6em" :width "5em"}} "Power On"]]]] [:tr [:td [:button {:on-click (fn [] (js/fetch (str "/press?button=OFF") (doto (object-array 0) (aset "method" "POST"))) (-> js/window (.-navigator) (.vibrate 200)))} [:div {:style {:font-size "6em" :width "5em"}} "Power Off"]]]] [:tr [:td [:h3 "Target Temperature"]]] [:tr [:td [:select {:style {:font-size "5.15em" :width "5em"} :on-change (fn [evt] (js/fetch (str "/press?button=" (-> evt (.-target) (.-value))) (doto (object-array 0) (aset "method" "POST"))) (-> js/window (.-navigator) (.vibrate 200)))} (for [i (range 61 81)] [:option (str i "°")])]]] [:tr [:td [:h3 "Fan Speed"]]] [:tr [:td [:select {:style {:font-size "5.15em" :width "5em"} :on-change (fn [evt] (js/fetch (str "/press?button=" (-> evt (.-target) (.-value))) (doto (object-array 0) (aset "method" "POST"))) (-> js/window (.-navigator) (.vibrate 200)))} (for [i ["HIGH" "MEDIUM" "LOW"]] [:option i])]]]]])] (.-body js/document))) ))
Generated At 2023-08-08T11:17:20-07:00 original