From 4cb82c8ca63a322e9b5ec0894e629b7983c46a66 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Wed, 21 Dec 2022 21:51:06 +0000
Subject: [PATCH] add socket repl

---
 .dir-locals.el  |  2 ++
 doc/index.html  | 12 ++++++++-
 dunlin.fnl      |  4 +++
 repl.sh         |  2 ++
 socket-repl.fnl | 71 +++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 90 insertions(+), 1 deletion(-)
 create mode 100644 .dir-locals.el
 create mode 100755 repl.sh
 create mode 100644 socket-repl.fnl

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..230273f
--- /dev/null
+++ 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
index 47e5e6b..592c2fe 100644
--- 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
index 0ff2cc2..98d7f73 100644
--- 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
new file mode 100755
index 0000000..2ca6e43
--- /dev/null
+++ 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
new file mode 100644
index 0000000..5db4132
--- /dev/null
+++ 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 }