Lots of tweaks, there's one more error I cannot figure out

bugafriend/listener.scm

@@ -2,15 +2,15 @@
   #:use-module (bugafriend utils registry)
   #:use-module (goblins)
   #:use-module (goblins ocapn ids)
-  #:export (listen))
+  #:export (listen-chat))
 
 ;; Code for the listener
 (define (^listener bcom)
   (lambda (text) (format #t "~a\n" text)))
 
-(define (listen setup-sref)
+(define (listen-chat setup-sref)
 (on (prelay-sref->mycapn-registry setup-sref)
     (lambda (registry)
-      (define listener (spawn ^listener))
-      (define listener-id ($ registry 'register listener))
-      (format #t "Listener registered at ~s\n" (ocapn-id->string listener-id)))))
+      (define chat-listener (spawn ^listener))
+      (define listener-id ($ registry 'register chat-listener))
+      (format #t "Share this with a friend so they can send a message: ~a\n" (ocapn-id->string listener-id)))))

bugafriend/ui.scm

@@ -6,62 +6,112 @@
   #:use-module (fibers)
   #:use-module (fibers channels)
   #:use-module (fibers conditions)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 readline)
   #:use-module (ice-9 suspendable-ports)
   #:export (say))
 
-;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO
-(let* ((input (current-input-port))
-       (flags (fcntl input F_GETFL)))
-  (fcntl input F_SETFL (logior O_NONBLOCK flags)))
-(install-suspendable-ports!)
+;; ;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO
+;; (let* ((input (current-input-port))
+;;        (flags (fcntl input F_GETFL)))
+;;   (fcntl input F_SETFL (logior O_NONBLOCK flags)))
+;; (install-suspendable-ports!)
 
-(define (%prompt) (format #t " > "))
+(define can-quit? (make-condition))
 
-(define registry #f)
-(define listener #f)
+(define ocapn-registry #f)
+(define listener-actor #f)
 
-(define (is-command? str) (eq? (string-ref str 0) #\/))
+(define (is-command? str)
+  (and (> (string-length str) 0) (eq? (string-ref str 0) #\/)))
 
-(define (%eval-command vat cmd)
+(define-record-type <console-command>
+  (make-console-command name help thunk)
+  console-command?
+  (name console-command-name)
+  (help console-command-help)
+  (thunk console-command-thunk))
+
+(define commands
+  (list
+   (make-console-command
+    "/quit"
+    "- Exits the chat"
+    (λ (args) (signal-condition! can-quit?)))
+   (make-console-command
+    "/help"
+    "- Prints this help"
+    (λ (args) (print-help)))
+   (make-console-command
+    "/join"
+    "<listener-id> - Switch chats to another listener"
+    (λ (args)
+      (unless (eq? 2 (length args))
+        (error "Need one argument, the listener sturdyref!"))
+
+      (let* ((listener-id (list-ref args 1))
+             (listener-sref (string->ocapn-id listener-id)))
+        (unless listener-sref
+          (error "Badly formatted sturdyref!"))
+        (unless ocapn-registry
+          (error "Relay not yet connected."))
+
+        (on (<- ocapn-registry 'enliven listener-sref)
+            (λ (l)
+              (set! listener-actor l)
+              (format #t "Connected to actor.\n"))))))))
+
+(define (print-help)
+  (format #t "Command reference:\n")
+  (map (λ (x) (format #t "  ~a ~a\n" (console-command-name x) (console-command-help x))) commands))
+
+(define command-names (map console-command-name commands))
+
+(define (%eval-command cmd)
   (define args (string-split cmd char-set:whitespace))
-  (match args
-    (("/quit" ...) #f) ;; Returns false so we quit the loop
-    (("/join" listener-id)
-     (define listener-sref (string->ocapn-id listener-id))
-     (with-vat vat
-      (on (<- registry 'enliven listener-sref)
-          (lambda (l)
-            (set! listener l)))))
-    (else
-     (format #t "Don't know how to handle ~a.\n" cmd)
-     #t)))
+  (define matching-command (find (λ (x) (equal? (console-command-name x) (car args))) commands))
+  (if matching-command
+      ((console-command-thunk matching-command) args)
+      (begin
+        (format #t "Don't know how to handle ~a.\n\n" cmd)
+        (print-help))))
 
+(define (read-line-vow)
+  (spawn-fibrous-vow
+   (λ ()
+     (read-line (readline-port)))))
 
-(define (%loop echo-vat)
-  (%prompt)
-  (let* ((line (read-line (current-input-port))))
-    (cond
-     ((is-command? line) (%eval-command echo-vat line))
-     (else
-      (if (and registry listener)
-          (with-vat echo-vat
-           (<- listener line)
-           #t)
-          (format #t "Not connected to anyone yet. Use /join <sturdyref>!"))))))
+(define (%loop)
+  (with-exception-handler (λ (e) (format #t "Command failed: ~s\n" e))
+    (on (read-line-vow)
+        (λ (line)
+          (cond
+           ((eq? 0 (string-length line)) #t)
+           ((is-command? line)
+            (%eval-command line))
+           (else
+            (unless listener-actor
+                (format #t "Not connected to anyone yet. Use /join <sturdyref>!\n"))
+            (<- listener-actor line)))
+          (%loop)))
+    #:unwind? #t))
 
-(define (say quit-cond setup-sref)
-  (with-vat
-   (spawn-vat #:name "Speaker UI")
-   (define echo-vat (spawn-vat))
-   (syscaller-free-fiber
-    (lambda ()
-      (with-vat echo-vat
-       (on (prelay-sref->mycapn-registry setup-sref)
-           (lambda (r)
-             (set! registry r))))
-      (while (%loop echo-vat))
-      (signal-condition! quit-cond)
-      (format #t "Bye!\n")))))
+(define (say setup-sref)
+  (define vat (spawn-vat #:name "Speaker Vat"))
+
+  (activate-readline)
+  (set-readline-prompt! " 🐞 > ")
+
+  (with-vat vat
+   (on (prelay-sref->mycapn-registry setup-sref)
+       (λ (r)
+         (set! ocapn-registry r)
+         (format #t "Connected to relay.\n")))
+
+   (%loop))
+
+  (wait can-quit?))

bugafriend/utils/registry.scm

@@ -20,5 +20,7 @@
 (define (prelay-sref->mycapn-registry setup-sref)
   (on (fetch-and-spawn-prelay-netlayer setup-sref)
       (lambda (netlayer)
+        (unless netlayer
+          (error "Couldn't spawn netlayer."))
         (spawn ^mycapn-registry netlayer 'prelay))
       #:promise? #t))

scripts/listen

@@ -12,6 +12,6 @@
 (define can-quit? (make-condition))
 
 (with-vat (spawn-vat #:name "Listener UI")
-  (listen (string->ocapn-id (list-ref (command-line) 1))))
+  (listen-chat (string->ocapn-id (list-ref (command-line) 1))))
 
 (wait can-quit?)

scripts/listen.in

@@ -12,6 +12,6 @@
 (define can-quit? (make-condition))
 
 (with-vat (spawn-vat #:name "Listener UI")
-  (listen (string->ocapn-id (list-ref (command-line) 1))))
+  (listen-chat (string->ocapn-id (list-ref (command-line) 1))))
 
 (wait can-quit?)

scripts/say

@@ -8,8 +8,4 @@
  (fibers conditions)
  (bugafriend ui))
 
-(define quit-cond (make-condition))
-
-(say quit-cond (string->ocapn-id (list-ref (command-line) 1)))
-
-(wait quit-cond)
+(say (string->ocapn-id (list-ref (command-line) 1)))

scripts/say.in

@@ -8,8 +8,4 @@
  (fibers conditions)
  (bugafriend ui))
 
-(define quit-cond (make-condition))
-
-(say quit-cond (string->ocapn-id (list-ref (command-line) 1)))
-
-(wait quit-cond)
+(say (string->ocapn-id (list-ref (command-line) 1)))