Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

With pod #77

Open
wants to merge 7 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 13 additions & 4 deletions project.clj
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
(defproject com.phronemophobic/membrane "0.11.1-beta"
(defproject com.phronemophobic/membrane "0.11.111-beta"
:description "A platform agnostic library for creating user interfaces"
:url "https://github.com/phronmophobic/membrane"
:license {:name "Apache License, Version 2.0"
Expand All @@ -21,8 +21,9 @@
;; [com.oracle/appbundler "1.0ea-local"]
;; [org.apache.ant/ant "1.10.5"]

;; For babaskha pod work
[nrepl/bencode "1.1.0"]
]

:aot [
]

Expand Down Expand Up @@ -56,7 +57,9 @@
:repositories {"sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"
"space-maven" "https://packages.jetbrains.team/maven/p/skija/maven"}
:profiles
{:dev {:dependencies
{
:clojure-1.10.3 {:dependencies [[org.clojure/clojure "1.10.3"]]}
:dev {:dependencies
[
[cider/piggieback "0.4.0"]

Expand Down Expand Up @@ -101,7 +104,13 @@
[org.lwjgl/lwjgl-opengl "3.3.0" :classifier "natives-macos"]
[org.lwjgl/lwjgl-opengl "3.3.0" :classifier "natives-macos-arm64"]
[org.lwjgl/lwjgl-opengl "3.3.0" :classifier "natives-linux"]
]}}
]}
:uberjar {:dependencies [[com.github.clj-easy/graal-build-time "0.1.0"]]
:jvm-opts ["-Dclojure.compiler.direct-linking=true"
"-Dclojure.spec.skip-macros=true"]
:main pod.tddpirate.membrane
:aot [pod.tddpirate.membrane]}
}

:deploy-repositories [["releases" :clojars]
["snapshots" :clojars]]
Expand Down
57 changes: 57 additions & 0 deletions script/compile
Original file line number Diff line number Diff line change
@@ -0,0 +1,57 @@
#!/usr/bin/env bash

if [ -z "$GRAALVM_HOME" ]; then
echo "Please set GRAALVM_HOME"
exit 1
fi

if [ ! -e "${GRAALVM_HOME}/bin/native-image" ]; then
echo "Your ${GRAALVM_HOME} does not have native-image, aborting."
exit 1
fi

export JAVA_HOME=$GRAALVM_HOME
export PATH=$GRAALVM_HOME/bin:$PATH

MEMBRANE_VERSION=0.11.111-beta #$(cat resources/CLJ_KONDO_VERSION)

lein with-profiles +clojure-1.10.3 "do" clean, uberjar

args=( "-jar" "target/membrane-$MEMBRANE_VERSION-standalone.jar"
"-H:+ReportExceptionStackTraces"
"--verbose"
"--no-fallback"
"--initialize-at-build-time"
"--initialize-at-run-time=sun.awt.dnd.SunDropTargetContextPeer$EventDispatcher"
"--initialize-at-run-time=sun.awt.X11.MotifDnDConstants"
"--initialize-at-run-time=sun.awt.X11.WindowPropertyGetter"
"--initialize-at-run-time=sun.awt.X11.XDataTransferer"
"--initialize-at-run-time=sun.awt.X11.XDnDConstants"
"--initialize-at-run-time=sun.awt.X11.XSelection"
"--initialize-at-run-time=sun.awt.X11.XSystemTrayPeer"
"--initialize-at-run-time=sun.awt.X11.XToolkitThreadBlockedHandler"
"--initialize-at-run-time=sun.awt.X11.XWindow"
"--initialize-at-run-time=sun.awt.X11.XWM"
"--initialize-at-run-time=sun.awt.X11GraphicsConfig"
"--initialize-at-run-time=sun.awt.X11InputMethodBase"
"-J-Xmx3g" "$@")
# "--initialize-at-run-time=sun.awt.X11" causes sun.awt.X11.XToolkit to complain about initialization at run time.
# "--initialize-at-run-time=sun.awt.dnd" causes a similar complaint.
# I OFFICIALLY GOT STUCK: ##############################################
# Error message requests that I add the option
# "--initialize-at-run-time=sun.awt.dnd.SunDropTargetContextPeer$EventDispatcher"
# However, this option is already in place.

if [ "$MEMBRANE_STATIC" = "true" ]; then
args+=("--static")
if [ "$MEMBRANE_MUSL" = "true" ]; then
args+=("--libc=musl"
# see https://github.com/oracle/graal/issues/3398
"-H:CCompilerOption=-Wl,-z,stack-size=2097152")
else
# see https://github.com/oracle/graal/issues/3737
args+=("-H:+StaticExecutableWithDynamicLibC")
fi
fi

"$GRAALVM_HOME/bin/native-image" "${args[@]}"
172 changes: 172 additions & 0 deletions src/pod/tddpirate/membrane.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,172 @@
(ns pod.tddpirate.membrane
{:no-doc true}
(:refer-clojure :exclude [read read-string])
(:require [bencode.core :as bencode]
[membrane.java2d]
[membrane.ui]
[membrane.component]
[membrane.basic-components]
[clojure.edn :as edn]
[clojure.java.io :as io])
(:import [java.io PushbackInputStream])
(:gen-class))

(set! *warn-on-reflection* true)

(def debug? false)
(defn debug [& args]
(when debug?
(binding [*out* (io/writer "/tmp/debug.log" :append true)]
(apply println args))))

(def stdin (PushbackInputStream. System/in))

(defn write [v]
(bencode/write-bencode System/out v)
(.flush System/out))

(defn read-string [^"[B" v]
(String. v))

(defn read []
(bencode/read-bencode stdin))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Create a lookup table from a namespace
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn ns+symbol->2tuple
"Transform a ns name and the name of a symbol inside it
into a 2-tuple for insertion into a map."
[podprefix ns symb] ;; podprefix is typically "pod.tddpirate."
{:pre [(string? podprefix)
(= (type ns) clojure.lang.Namespace)
(symbol? symb)]}
(let [fullpodns (str podprefix (str ns))]
;;(println "!!! DEBUG\npodprefix =" podprefix "\nns =" ns "\nsymb =" symb "\nfullpodns =" fullpodns "\n!!! DEBUG (end)")
;;(println "!!!------------")
;;(println "!!! symbol 1" (symbol fullpodns (str symb)))
;;(println "!!!------------")
;;(println "!!! symbol 2" (ns-resolve ns symb))
;;(println "!!!------------")
[(symbol fullpodns (str symb))
(ns-resolve ns symb)]))

(defn nsmap->lookup
"Transform the output of ns-map into a map which transforms
pod.tddpirate.* variables into membrane variables.
The argument is ns symbol, however."
[nssym]
{:pre [(symbol? nssym)]}
(let [ns (find-ns nssym)]
(->> (map #(ns+symbol->2tuple "pod.tddpirate." ns %) (-> ns ns-map keys))
(into {}))))


(def lookup
"The caller needs to apply var-get to the result of (lookup 'namespace/name)"
(merge
(nsmap->lookup 'membrane.java2d)
(nsmap->lookup 'membrane.ui)
(nsmap->lookup 'membrane.component)
(nsmap->lookup 'membrane.basic-components)))
;; obsolete version
;; {'pod.borkdude.clj-kondo/merge-configs clj-kondo/merge-configs
;; 'clj-kondo.core/merge-configs clj-kondo/merge-configs
;; 'pod.borkdude.clj-kondo/run! clj-kondo/run!
;; 'clj-kondo.core/run! clj-kondo/run!})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Create a description of a namespace
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn nsmap->maps
"Transform the output of ns-map into a vector whose
entries are maps from string \"name\" into symbol names."
[nsmapoutput]
(mapv #(as-> (% 0) val (name val) {"name" val}) nsmapoutput))

(defn describe-ns
"Given a namespace, create a namespace description for the
describe operation."
[ns]
{:pre [(= (type ns) clojure.lang.Namespace)]}
{"name" (-> ns ns-name name)
"vars" (-> ns
ns-map
nsmap->maps)})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn pod-ns---example-of-CODE-usge
"!!! TODO Not actually used, retained to serve as an example."
[name]
{"name" name
"vars" [{"name" "merge-configs"}
{"name" "print!"
"code" "
(defn print! [run-output]
(print (print* run-output))
(flush))"}
{"name" "run!"}]})

(defn run-pod []
(loop []
(let [message (try (read)
(catch java.io.EOFException _
::EOF))]
(when-not (identical? ::EOF message)
(let [op (get message "op")
op (read-string op)
op (keyword op)
id (some-> (get message "id")
read-string)
id (or id "unknown")]
(case op
:describe (do (write {"format" "edn"
"namespaces" [(describe-ns (find-ns 'membrane.java2d))
(describe-ns (find-ns 'membrane.ui))
(describe-ns (find-ns 'membrane.component))
(describe-ns (find-ns 'membrane.basic-components))
]
"id" id})
(recur))
:invoke (do (try
(let [var (-> (get message "var")
read-string
symbol)
args (get message "args")
args (read-string args)
args (edn/read-string args)]
(if-let [f (var-get (lookup var))]
(let [value (pr-str (apply f args))
reply {"value" value
"id" id
"status" ["done"]}]
(write reply))
(throw (ex-info (str "Var not found: " var) {}))))
(catch Throwable e
(binding [*out* *err*]
(println e))
(let [reply {"ex-message" (.getMessage e)
"ex-data" (pr-str
(assoc (ex-data e)
:type (class e)))
"id" id
"status" ["done" "error"]}]
(write reply))))
(recur))
(do
(write {"err" (str "unknown op:" (name op))})
(recur))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn -main
"Entry point for working as a Babashka pod."
[ & args ]
(if (= "true" (System/getenv "BABASHKA_POD"))
(run-pod)
(do
(println "*** NOT OPERATING AS A BABASHKA POD - ABORTING ***")
(System/exit 1))))