dunlin

commit 4cb82c8ca63a322e9b5ec0894e629b7983c46a66
parent 512e8cad2f0da8c20f41cd5e595a737c0855bb9d
Author: Daniel Barlow <dan@telent.net>
Date:   Wed, 21 Dec 2022 21:51:06 +0000

add socket repl

Diffstat:
A
.dir-locals.el
 | 
2
++
M
doc/index.html
 | 
12
+++++++++++-
M
dunlin.fnl
 | 
4
++++
A
repl.sh
 | 
2
++
A
socket-repl.fnl
 | 
71
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

5 files changed, 90 insertions(+), 1 deletion(-)
diff --git a/.dir-locals.el b/.dir-locals.el
@@ -0,0 +1,2 @@
+((fennel-mode .
+	      ((inferior-lisp-program . "./repl.sh"))))
diff --git a/doc/index.html b/doc/index.html
@@ -28,9 +28,19 @@
     nix-shell$ overmind connect
   </pre>
 
-  This starts a fennel interpreter and a test runner in tmux windows.
+  This starts a Fennel interpreter and a test runner in tmux windows.
   Use <pre>C-b n</pre> to switch between them or <pre>C-b d</pre>
   to detach.
 
+  <pre>
+    $ fennel dunlin.fnl &
+    $ ./repl.sh
+  </pre>
+
+  Dunlin will open a socket in <tt>$XDG_RUNTIME_DIR</tt> to allow
+  communication with a Fennel REPL. The <tt>repl.sh</tt> script
+  uses <a href="http://www.dest-unreach.org/socat/">socat</a>
+  to connect to it.
+
 
 </html>
diff --git a/dunlin.fnl b/dunlin.fnl
@@ -10,4 +10,8 @@
   (f:show-buffer b)
   (b:visit (.. "file://" (lfs.currentdir) "/doc/index.html")))
 
+(let [socketdir (or (os.getenv "XDG_RUNTIME_DIR") (os.getenv "HOME"))]
+  ((. (require :socket-repl) :start)
+   (.. socketdir "/dunlin.sock")))
+
 (Gtk.main)
diff --git a/repl.sh b/repl.sh
@@ -0,0 +1,2 @@
+#!/usr/bin/env nix-shell
+#! nix-shell -p socat  --run "socat - unix-connect:${XDG_RUNTIME_DIR-$HOME}/dunlin.sock"
diff --git a/socket-repl.fnl b/socket-repl.fnl
@@ -0,0 +1,71 @@
+(local { : fdopen } (require "posix.stdio"))
+(local fcntl (require "posix.fcntl"))
+(local unistd (require "posix.unistd"))
+(local socket (require "posix.sys.socket"))
+(local lgi (require :lgi))
+
+(local { : GLib } lgi)
+
+(local { : repl } (require :fennel))
+
+
+(fn watch-fd [fd mode handler]
+  (let [events [ GLib.IOCondition.IN GLib.IOCondition.HUP]
+        channel (GLib.IOChannel.unix_new fd)]
+    (GLib.io_add_watch channel 0 events #(handler fd))))
+
+(fn unix-socket-listener [pathname on-connected]
+  (let [sa {:family socket.AF_UNIX
+            :path pathname
+            }
+        fd (socket.socket socket.AF_UNIX socket.SOCK_STREAM 0)]
+    (socket.bind fd sa)
+    (socket.listen fd 5)
+    (watch-fd
+     fd fcntl.O_RDWR
+     #(let [connected-fd (socket.accept $1)]
+        (on-connected connected-fd)))
+    ))
+
+(fn get-input [fd]
+  (let [buf (unistd.read fd 1024)]
+    (if (and buf (> (# buf) 0))
+        buf
+        "\n,exit")))
+
+(fn start [pathname]
+  (unistd.unlink pathname)
+  (unix-socket-listener
+   pathname
+   (fn [fd]
+     (let [sock (fdopen fd "w+")
+           repl-coro (coroutine.create repl)]
+       (watch-fd fd fcntl.O_RDONLY
+                 (fn [fd]
+                   (coroutine.resume repl-coro (get-input  fd))
+                   (if (= (coroutine.status repl-coro) :dead)
+                       (do
+                         (sock:write "bye!\n")
+                         (sock:close)
+                         false)
+                       true
+                       )))
+       (coroutine.resume repl-coro
+                         {:readChunk
+                          (fn [{: stack-size}]
+                            (sock:write
+                             (if (> stack-size 0) ".." ">> "))
+                            (sock:flush)
+                            (coroutine.yield))
+                          :onValues
+                          (fn [vals]
+                            (sock:write (table.concat vals "\t"))
+                            (sock:write "\n"))
+                          :onError
+                          (fn [errtype err]
+                            (sock:write
+                             (.. errtype " error: " (tostring err) "\n")))
+                          })))))
+
+
+{ : start }