Updating copyright headers to be more "modern"
[8sync.git] / eightsync / systems / irc.scm
index bf450b94efc526ef680e9472c7804438b5386ee9..c872b468a26a512dd40bd3a330f5b1f167c67ef7 100755 (executable)
@@ -2,22 +2,23 @@
 -e main -s
 !#
 
-;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
-
-;; This library is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU Lesser General Public
-;; License as published by the Free Software Foundation; either
-;; version 3 of the License, or (at your option) any later version.
-;;
-;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; Lesser General Public License for more details.
-;;
-;; You should have received a copy of the GNU Lesser General Public
-;; License along with this library; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-;; 02110-1301 USA
+;;; 8sync --- Asynchronous programming for Guile
+;;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+;;;
+;;; This file is part of 8sync.
+;;;
+;;; 8sync is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; 8sync is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with 8sync.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (eightsync systems irc)
   #:use-module (eightsync repl)
@@ -30,7 +31,7 @@
   #:use-module (ice-9 match)
   #:export (;; The only things you definitely need if writing a bot
             make-irc-bot-cli            
-            irc-format irc-display
+            irc-format irc-display irc-send-message irc-send-formatted
             
             ;; Useful things if you're making something more complicated
             irc-line
       (display (irc-line line) dest)
       (display (irc-line dest))))
 
+(define (irc-send-message socket channel message)
+  (irc-format socket "PRIVMSG ~a :~a" channel message))
+
+(define-syntax-rule (irc-send-formatted socket channel format-string
+                                        args ...)
+  (irc-format socket "PRIVMSG ~a :~a" channel
+              (format #f format-string args ...)))
+
 (define* (handle-login socket username
                        #:key
                        (hostname "*")
                (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"
          (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)))))
         (set! buffer (cons (read-char socket) buffer))
         (match buffer
           ((#\newline #\return (? char? line-chars) ...)
-           (%sync (%run (handle-line
-                         socket
-                         (list->string (reverse line-chars))
-                         username)))
-           ;; reset buffer
-           (set! buffer '()))
+           (let ((ready-line (list->string (reverse line-chars))))
+             ;; reset buffer
+             (set! buffer '())
+             ;; run it
+             (%8sync (%run (handle-line
+                            socket
+                            ready-line
+                            username)))))
           (_ #f))))
     irc-handler))
 
     (channels (value #t))
     (listen)))
 
-(define* (make-irc-bot-cli #:optional (line-handler default-line-handler))
+(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))
            (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)
   main)
 
 (define main (make-irc-bot-cli))
-