Provide a way to fail gracefully on errors, and use it in irc.scm

[8sync.git] / eightsync / systems / irc.scm

diff --git a/eightsync/systems/irc.scm b/eightsync/systems/irc.scm
index a802167726ba8805967aa53a4864624b6eeeaae5..0907bcdd21e36594b5197c599af12b8e381e5250 100755 (executable)
--- a/eightsync/systems/irc.scm
+++ b/eightsync/systems/irc.scm
@@ -187,7 +187,7 @@
                (string-join (cons first-word rest-message) " ")
                #f)))))
 
-(define (echo-back-message my-name speaker
+(define (echo-back-message socket my-name speaker
                            channel-name message is-action)
   (if is-action
       (format #t "~a emoted ~s in channel ~a\n"
@@ -208,7 +208,8 @@
          (receive (channel-name message is-action)
              (condense-privmsg-line (irc-line-params parsed-line))
            (let ((username (irc-line-username parsed-line)))
-             (handle-privmsg my-username username channel-name message is-action))))
+             (handle-privmsg socket my-username username
+                             channel-name message is-action))))
         (_
          (display line)
          (newline)))))
@@ -225,7 +226,7 @@
         (set! buffer (cons (read-char socket) buffer))
         (match buffer
           ((#\newline #\return (? char? line-chars) ...)
-           (%sync (%run (handle-line
+           (%8sync (%run (handle-line
                          socket
                          (list->string (reverse line-chars))
                          username)))
@@ -234,19 +235,22 @@
           (_ #f))))
     irc-handler))
 
+(define default-line-handler (make-handle-line))
 
 (define* (queue-and-start-irc-agenda! agenda socket #:key
                                       (username "syncbot")
                                       (inet-port default-irc-port)
-                                      (handler (make-basic-irc-handler
-                                                (lambda args
-                                                  (apply (make-handle-line) args))
-                                                username))
+                                      (line-handler default-line-handler)
                                       (channels '()))
   (dynamic-wind
     (lambda () #f)
     (lambda ()
-      (enq! (agenda-queue agenda) (wrap (install-socket socket handler)))
+      (enq! (agenda-queue agenda)
+            (wrap (install-socket
+                   socket
+                   (make-basic-irc-handler
+                    line-handler
+                    username))))
       (enq! (agenda-queue agenda) (wrap (handle-login socket username
                                                       #:channels channels)))
       (start-agenda agenda))
@@ -270,7 +274,9 @@
     (channels (value #t))
     (listen)))
 
-(define* (make-irc-bot-cli)
+(define* (make-irc-bot-cli #:optional
+                           (line-handler default-line-handler)
+                           (print-and-continue-on-error #t))
   (define (main args)
     (let* ((options (getopt-long args option-spec))
            (hostname (option-ref options 'server #f))
@@ -279,7 +285,9 @@
            (username (option-ref options 'username #f))
            (listen (option-ref options 'listen #f))
            (channels (option-ref options 'channels ""))
-           (agenda (make-agenda)))
+           (agenda (if print-and-continue-on-error
+                       (make-agenda #:pre-unwind-handler print-error-and-continue)
+                       (make-agenda))))
       (display `((server ,hostname) (port ,port) (username ,username)
                  (listen ,listen) (channels-split ,(string-split channels #\space))))
       (newline)
@@ -290,8 +298,8 @@
        (irc-socket-setup hostname port)
        #:inet-port port
        #:username username
-       #:channels (string-split channels #\space))))
+       #:channels (string-split channels #\space)
+       #:line-handler line-handler)))
   main)
 
 (define main (make-irc-bot-cli))
-