From 1dec705a02f9c069797579d5f0cfda9180a8dd15 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 20 Dec 2016 14:23:45 -0600 Subject: [PATCH 01/16] Add toplevel 8sync.scm file. * 8sync.scm: New file. * Makefile.am: Add it. --- 8sync.scm | 28 ++++++++++++++++++++++++++++ Makefile.am | 1 + 2 files changed, 29 insertions(+) create mode 100644 8sync.scm diff --git a/8sync.scm b/8sync.scm new file mode 100644 index 0000000..9c074bd --- /dev/null +++ b/8sync.scm @@ -0,0 +1,28 @@ +;;; 8sync --- Asynchronous programming for Guile +;;; Copyright (C) 2016 Christopher Allan Webber +;;; +;;; 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 . + +(define-module (8sync)) + +(eval-when (eval load compile) + (begin + (define %public-modules + '(agenda actors)) + (for-each (lambda (m) + (module-use! (module-public-interface (current-module)) + (resolve-interface `(8sync ,m)))) + %public-modules))) diff --git a/Makefile.am b/Makefile.am index 83ab6b0..19f8da7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -45,6 +45,7 @@ moddir=$(prefix)/share/guile/site/2.0 godir=$(libdir)/guile/2.0/ccache SOURCES = \ + 8sync.scm \ 8sync/agenda.scm \ 8sync/repl.scm \ 8sync/systems/irc.scm \ -- 2.31.1 From 3d6f2e7cd2ec140db3a32c0f2a999b63b718a935 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 20 Dec 2016 15:28:10 -0600 Subject: [PATCH 02/16] actors: Document the records's fields. * 8sync/actors.scm (): Add comments. --- 8sync/actors.scm | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index fdcbc85..c694c48 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -122,14 +122,15 @@ body in-reply-to wants-reply replied) message? - (id message-id) - (to message-to) - (from message-from) - (action message-action) - (body message-body) - (in-reply-to message-in-reply-to) - (wants-reply message-wants-reply) - (replied message-replied set-message-replied!)) + (id message-id) ; id of this message + (to message-to) ; actor id this is going to + (from message-from) ; actor id of sender + (action message-action) ; action (a symbol) to be handled + (body message-body) ; argument list "body" of message + (in-reply-to message-in-reply-to) ; message id this is in reply to, if any + (wants-reply message-wants-reply) ; whether caller is waiting for reply + (replied message-replied ; was this message replied to? + set-message-replied!)) (define* (make-message id to from action body -- 2.31.1 From 5dc2dceda9fab1eb92295989e8e8940fbd56a12c Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 20 Dec 2016 15:51:56 -0600 Subject: [PATCH 03/16] agenda: Fixing exports. * 8sync/agenda.scm: Removed deprecated variables 8sync-delay, 8sync-run, 8sync-run-at, and 8sync-run-delay. Added 8usleep. --- 8sync/agenda.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/8sync/agenda.scm b/8sync/agenda.scm index 9884afc..b41500d 100644 --- a/8sync/agenda.scm +++ b/8sync/agenda.scm @@ -60,10 +60,8 @@ run-it wrap wrap-apply run run-at run-delay - 8sync-delay - 8sync-run 8sync-run-at 8sync-run-delay 8sync - 8sleep + 8sleep 8usleep ;; used for introspecting the error, but a method for making ;; is not exposed -- 2.31.1 From 5fb86bd7b6e77c0cc978060fa1e9c080d537dbc7 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 20 Dec 2016 17:09:19 -0600 Subject: [PATCH 04/16] actors: Switch coroutine waiting code over to using case. * 8sync/actors.scm (hive-process-message): Update resume-waiting-coroutine code over to using a case statement. --- 8sync/actors.scm | 83 +++++++++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 39 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index c694c48..2ce7e14 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -512,45 +512,50 @@ to come after class definition." result)))))) (define (resume-waiting-coroutine) - (cond - ((or (eq? (message-action message) '*reply*) - (eq? (message-action message) '*auto-reply*)) - (call-catching-coroutine - (lambda () - (match (hash-remove! (hive-waiting-coroutines hive) - (message-in-reply-to message)) - ((_ . (resume-actor-id . kont)) - (if (not (equal? (message-to message) - resume-actor-id)) - (throw 'resuming-to-wrong-actor - "Attempted to resume a coroutine to the wrong actor!" - #:expected-actor-id (message-to message) - #:got-actor-id resume-actor-id - #:message message)) - (let (;; @@: How should we resolve resuming coroutines to actors who are - ;; now gone? - (actor (resolve-actor-to)) - (result (kont message))) - (maybe-autoreply actor) - result)) - (#f (throw 'no-waiting-coroutine - "message in-reply-to tries to resume nonexistent coroutine" - message)))))) - ;; Yikes, we must have gotten an error or something back - (else - ;; @@: Not what we want in the long run? - ;; What we'd *prefer* to do is to resume this message - ;; and throw an error inside the message handler - ;; (say, from send-mesage-wait), but that causes a SIGABRT (??!!) - (hash-remove! (hive-waiting-coroutines hive) - (message-in-reply-to message)) - (let ((explaination - (if (eq? (message-action message) '*reply*) - "Won't resume coroutine; got an *error* as a reply" - "Won't resume coroutine because action is not *reply*"))) - (throw 'hive-unresumable-coroutine - explaination - #:message message))))) + (case (message-action message) + ;; standard reply / auto-reply + ((*reply* *auto-reply*) + (call-catching-coroutine + (lambda () + (match (hash-remove! (hive-waiting-coroutines hive) + (message-in-reply-to message)) + ((_ . (resume-actor-id . kont)) + (if (not (equal? (message-to message) + resume-actor-id)) + (throw 'resuming-to-wrong-actor + "Attempted to resume a coroutine to the wrong actor!" + #:expected-actor-id (message-to message) + #:got-actor-id resume-actor-id + #:message message)) + (let (;; @@: How should we resolve resuming coroutines to actors who are + ;; now gone? + (actor (resolve-actor-to)) + (result (kont message))) + (maybe-autoreply actor) + result)) + (#f (throw 'no-waiting-coroutine + "message in-reply-to tries to resume nonexistent coroutine" + message)))))) + ;; Yikes, an error! + ((*error*) + ;; @@: Not what we want in the long run? + ;; What we'd *prefer* to do is to resume this message + ;; and throw an error inside the message handler + ;; (say, from send-mesage-wait), but that causes a SIGABRT (??!!) + (hash-remove! (hive-waiting-coroutines hive) + (message-in-reply-to message)) + (let ((explaination + (if (eq? (message-action message) '*reply*) + "Won't resume coroutine; got an *error* as a reply" + "Won't resume coroutine because action is not *reply*"))) + (throw 'hive-unresumable-coroutine + explaination #:message message))) + ;; Unhandled action for a reply! + (else + (throw 'hive-unresumable-coroutine + "Won't resume coroutine, nonsense action on reply message" + #:action (message-action message) + #:message message)))) (define (process-remote-message) ;; Find the ambassador -- 2.31.1 From f768ab48d6a073412021e8ce56508cdeef45a444 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Wed, 21 Dec 2016 12:51:33 -0600 Subject: [PATCH 05/16] actors: Generalize the <-foo methods functionality into send-message. * 8sync/actors.scm (send-message): New procedure. (<-, <-wait, <-reply, <-auto-reply, <-reply-wait): Update to use send-message. --- 8sync/actors.scm | 75 ++++++++++++++++++++++++------------------------ 1 file changed, 37 insertions(+), 38 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index 2ce7e14..b651d55 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -165,23 +165,42 @@ ;;; See: https://web.archive.org/web/20081223021934/http://mumble.net/~jar/articles/oo-moon-weinreb.html ;;; (also worth seeing: http://mumble.net/~jar/articles/oo.html ) +;; This is the internal, generalized message sending method. +;; Users shouldn't use it! Use the <-foo forms instead. + +;; @@: Could we get rid of some of the conditional checks through +;; some macro-foo? +(define-inlinable (send-message xtra-params from-actor to-id action + replying-to-message wants-reply? + message-body-args) + (if replying-to-message + (set-message-replied! replying-to-message #t)) + (let* ((hive (actor-hive from-actor)) + (new-message + (make-message (hive-gen-message-id hive) to-id + (actor-id from-actor) action + message-body-args + #:wants-reply wants-reply? + #:in-reply-to + (if replying-to-message + (message-id replying-to-message) + #f)))) + ;; TODO: add xtra-params to both of these + (if wants-reply? + (abort-to-prompt (hive-prompt (actor-hive from-actor)) + from-actor new-message) + (8sync (hive-process-message hive new-message))))) + + (define (<- from-actor to-id action . message-body-args) "Send a message from an actor to another actor" - (let* ((hive (actor-hive from-actor)) - (message (make-message (hive-gen-message-id hive) to-id - (actor-id from-actor) action - message-body-args))) - (8sync (hive-process-message hive message)))) + (send-message '() from-actor to-id action + #f #f message-body-args)) (define (<-wait from-actor to-id action . message-body-args) "Send a message from an actor to another, but wait until we get a response" - (let* ((hive (actor-hive from-actor)) - (abort-to (hive-prompt (actor-hive from-actor))) - (message (make-message (hive-gen-message-id hive) to-id - (actor-id from-actor) action - message-body-args - #:wants-reply #t))) - (abort-to-prompt abort-to from-actor message))) + (send-message '() from-actor to-id action + #f #t message-body-args)) ;; TODO: Intelligently ~propagate(ish) errors on -wait functions. ;; We might have `send-message-wait-brazen' to allow callers to @@ -190,38 +209,18 @@ (define (<-reply from-actor original-message . message-body-args) "Reply to a message" - (set-message-replied! original-message #t) - (let* ((hive (actor-hive from-actor)) - (new-message (make-message (hive-gen-message-id hive) - (message-from original-message) - (actor-id from-actor) '*reply* - message-body-args - #:in-reply-to (message-id original-message)))) - (8sync (hive-process-message hive new-message)))) + (send-message '() from-actor (message-from original-message) '*reply* + original-message #f message-body-args)) (define (<-auto-reply from-actor original-message) "Auto-reply to a message. Internal use only!" - (set-message-replied! original-message #t) - (let* ((hive (actor-hive from-actor)) - (new-message (make-message (hive-gen-message-id hive) - (message-from original-message) - (actor-id from-actor) '*auto-reply* - '() - #:in-reply-to (message-id original-message)))) - (8sync (hive-process-message hive new-message)))) + (send-message '() from-actor (message-from original-message) '*auto-reply* + original-message #f '())) (define (<-reply-wait from-actor original-message . message-body-args) "Reply to a messsage, but wait until we get a response" - (set-message-replied! original-message #t) - (let* ((hive (actor-hive from-actor)) - (abort-to (hive-prompt (actor-hive from-actor))) - (new-message (make-message (hive-gen-message-id hive) - (message-from original-message) - (actor-id from-actor) '*reply* - message-body-args - #:wants-reply #t - #:in-reply-to (message-id original-message)))) - (abort-to-prompt abort-to from-actor new-message))) + (send-message '() from-actor (message-from original-message) '*reply* + original-message #t message-body-args)) -- 2.31.1 From 5fa0225a261a031fc8cd2988932e6a3e8f4528fb Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Wed, 21 Dec 2016 17:00:43 -0600 Subject: [PATCH 06/16] actors: Move error propagation within <-wait; add <-wait*, <-reply-wait*. * 8sync/actors.scm (send-message): Rename xtra-params argument to send-options and use it in aborting to the hive prompt. (<-wait*, <-reply-wait*): New procedures. These allow for adding a send-options list as a first argument, including #:accept-errors. These also wrap call wait-maybe-handle-errors. (<-wait, <-reply-wait): Updated as thin wrappers around <-wait* and <-reply-wait*. (wait-maybe-handle-errors): New procedure. (): New record type. (hive-process-message): Update to accept send-options and make use of . Removes error handling, which now hapens in wait-maybe-handle-errors. --- 8sync/actors.scm | 92 +++++++++++++++++++++++++++++++----------------- 1 file changed, 60 insertions(+), 32 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index b651d55..867e3d0 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -70,7 +70,7 @@ message-auto-reply? - <- <-wait <-reply <-reply-wait + <- <-wait <-wait* <-reply <-reply-wait <-reply-wait* call-with-message msg-receive msg-val @@ -170,7 +170,8 @@ ;; @@: Could we get rid of some of the conditional checks through ;; some macro-foo? -(define-inlinable (send-message xtra-params from-actor to-id action + +(define-inlinable (send-message send-options from-actor to-id action replying-to-message wants-reply? message-body-args) (if replying-to-message @@ -185,10 +186,13 @@ (if replying-to-message (message-id replying-to-message) #f)))) - ;; TODO: add xtra-params to both of these (if wants-reply? (abort-to-prompt (hive-prompt (actor-hive from-actor)) - from-actor new-message) + from-actor new-message send-options) + ;; @@: It might be that eventually we pass in send-options + ;; here too. Since <-wait and <-reply-wait are the only ones + ;; that use it yet, for now it kind of just makes things + ;; confusing. (8sync (hive-process-message hive new-message))))) @@ -197,10 +201,17 @@ (send-message '() from-actor to-id action #f #f message-body-args)) +(define (<-wait* send-options from-actor to-id action . message-body-args) + "Like <-wait, but allows extra parameters, for example whether to +#:accept-errors" + (apply wait-maybe-handle-errors + (send-message send-options from-actor to-id action + #f #t message-body-args) + send-options)) + (define (<-wait from-actor to-id action . message-body-args) "Send a message from an actor to another, but wait until we get a response" - (send-message '() from-actor to-id action - #f #t message-body-args)) + (apply <-wait* '() from-actor to-id action message-body-args)) ;; TODO: Intelligently ~propagate(ish) errors on -wait functions. ;; We might have `send-message-wait-brazen' to allow callers to @@ -217,10 +228,31 @@ (send-message '() from-actor (message-from original-message) '*auto-reply* original-message #f '())) +(define (<-reply-wait* send-options from-actor original-message + . message-body-args) + "Reply to a messsage, but wait until we get a response" + (apply wait-maybe-handle-errors + (send-message send-options from-actor + (message-from original-message) '*reply* + original-message #t message-body-args) + send-options)) + (define (<-reply-wait from-actor original-message . message-body-args) "Reply to a messsage, but wait until we get a response" - (send-message '() from-actor (message-from original-message) '*reply* - original-message #t message-body-args)) + (apply <-reply-wait* '() from-actor original-message message-body-args)) + +(define* (wait-maybe-handle-errors message + #:key accept-errors + #:allow-other-keys) + "Before returning a message to a waiting caller, see if we need to +raise an exception if an error." + (define action (message-action message)) + (cond ((and (eq? action '*error*) + (not accept-errors)) + (throw 'hive-unresumable-coroutine + "Won't resume coroutine; got an *error* as a reply" + #:message message)) + (else message))) @@ -438,6 +470,14 @@ to come after class definition." ;; unresumable continuation. (lambda () (hive-process-message hive new-message)))) +(define-record-type + (make-waiting-on-reply actor-id kont send-options) + waiting-on-reply? + (actor-id waiting-on-reply-actor-id) + (kont waiting-on-reply-kont) + (send-options waiting-on-reply-send-options)) + + (define-method (hive-process-message (hive ) message) "Handle one message, or forward it via an ambassador" (define (maybe-autoreply actor) @@ -487,11 +527,12 @@ to come after class definition." (8sync (queued-error-handling-thunk)))) (call-with-prompt (hive-prompt hive) call-catching-errors - (lambda (kont actor message) + (lambda (kont actor message send-options) ;; Register the coroutine (hash-set! (hive-waiting-coroutines hive) (message-id message) - (cons (actor-id actor) kont)) + (make-waiting-on-reply + (actor-id actor) kont send-options)) ;; Send off the message (8sync (hive-process-message hive message))))) @@ -513,42 +554,29 @@ to come after class definition." (define (resume-waiting-coroutine) (case (message-action message) ;; standard reply / auto-reply - ((*reply* *auto-reply*) + ((*reply* *auto-reply* *error*) (call-catching-coroutine (lambda () (match (hash-remove! (hive-waiting-coroutines hive) (message-in-reply-to message)) - ((_ . (resume-actor-id . kont)) + ((_ . waiting) (if (not (equal? (message-to message) - resume-actor-id)) + (waiting-on-reply-actor-id waiting))) (throw 'resuming-to-wrong-actor "Attempted to resume a coroutine to the wrong actor!" #:expected-actor-id (message-to message) - #:got-actor-id resume-actor-id + #:got-actor-id (waiting-on-reply-actor-id waiting) #:message message)) - (let (;; @@: How should we resolve resuming coroutines to actors who are - ;; now gone? - (actor (resolve-actor-to)) - (result (kont message))) + (let* (;; @@: How should we resolve resuming coroutines to actors who are + ;; now gone? + (actor (resolve-actor-to)) + (kont (waiting-on-reply-kont waiting)) + (result (kont message))) (maybe-autoreply actor) result)) (#f (throw 'no-waiting-coroutine "message in-reply-to tries to resume nonexistent coroutine" message)))))) - ;; Yikes, an error! - ((*error*) - ;; @@: Not what we want in the long run? - ;; What we'd *prefer* to do is to resume this message - ;; and throw an error inside the message handler - ;; (say, from send-mesage-wait), but that causes a SIGABRT (??!!) - (hash-remove! (hive-waiting-coroutines hive) - (message-in-reply-to message)) - (let ((explaination - (if (eq? (message-action message) '*reply*) - "Won't resume coroutine; got an *error* as a reply" - "Won't resume coroutine because action is not *reply*"))) - (throw 'hive-unresumable-coroutine - explaination #:message message))) ;; Unhandled action for a reply! (else (throw 'hive-unresumable-coroutine -- 2.31.1 From d0a86ba4c62607a2051729a81844adabb2760b25 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Thu, 22 Dec 2016 19:46:46 -0600 Subject: [PATCH 07/16] actors: Add docstring to hive-create-actor*. * 8sync/actors.scm (hive-create-actor*): Added docstring. --- 8sync/actors.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/8sync/actors.scm b/8sync/actors.scm index 867e3d0..9b079b8 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -632,6 +632,7 @@ that method for documentation." init #f)) (define* (hive-create-actor* hive actor-class id-cookie #:rest init) + "Create an actor, but also add a 'cookie' to the name for debugging" (%hive-create-actor hive actor-class init id-cookie)) -- 2.31.1 From 3e27bb39df3dbaf65bd0581131610bfe6c824720 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Fri, 23 Dec 2016 08:50:06 -0600 Subject: [PATCH 08/16] irc: Update irc code to use actors. Also some significant cleanup. But more can still be done! * 8sync/systems/irc.scm: Adjust exports. (irc-line, irc-format, irc-display, irc-send-message) (irc-send-formatted, handle-login, ) (default-handle-privmsg, make-handle-line, irc-loop) (default-line-handler, queue-and-start-irc-agenda!): Removed. (parse-line): Return multiple values rather than the record. (irc-line-username): Update to use prefix rather than pulling out of . (condense-privmsg-line): Update docstring to call `is-action' `emote?'. (echo-message): Renamed from echo-back-message. Change argument list and body to match new version and add docstring. (, irc-bot-username, irc-bot-server, irc-bot-channels) (default-irc-port, irc-bot-line-handler, irc-bot-socket) (irc-bot-realname, irc-bot-init, irc-bot-main-loop, irc-bot-dispatch-line) (irc-bot-send-line): New variables. * demos/ircbot.scm (handle-line): Renamed from `handle-message'. Adjust body for actors edition. (display-help, parse-args, run-bot): New variables. (main): Adjusted for new structure. --- 8sync/systems/irc.scm | 290 ++++++++++++++++-------------------------- demos/ircbot.scm | 103 ++++++++++++--- 2 files changed, 192 insertions(+), 201 deletions(-) diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm index 6262f43..e912e5f 100755 --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -23,6 +23,7 @@ (define-module (8sync systems irc) #:use-module (8sync repl) #:use-module (8sync agenda) + #:use-module (8sync actors) #:use-module (srfi srfi-9) #:use-module (ice-9 getopt-long) #:use-module (ice-9 format) @@ -30,30 +31,12 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 q) #: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-send-message irc-send-formatted - - ;; Useful things if you're making something more complicated - irc-line - irc-eol + #:use-module (oop goops) + #:export ( + irc-bot-username irc-bot-server irc-bot-channels + irc-bot-port irc-bot-handler - default-irc-port - - startswith-colon? - - - make-irc-line irc-line? - irc-line-prefix irc-line-command irc-line-params - - parse-line - irc-line-username - - condense-privmsg-line - echo-back-message - - make-handle-line make-basic-irc-handler - queue-and-start-irc-agenda!)) + default-irc-port)) ;;; Network stuff @@ -73,59 +56,12 @@ (define irc-eol "\r\n") -(define (irc-line line) - (string-concatenate (list line irc-eol))) - -(define-syntax-rule (irc-format dest format-string rest ...) - (let ((line (string-concatenate - (list (format #f format-string rest ...) - irc-eol)))) - (match dest - (#f line) - (#t (display line)) - (else - (display line dest))))) - -(define* (irc-display line #:optional dest) - (if dest - (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 "*") - (servername "*") - (realname username) - (channels '())) - (irc-format socket "USER ~a ~a ~a :~a" - username hostname servername realname) - (irc-format socket "NICK ~a" username) - (for-each - (lambda (channel) - (irc-format socket "JOIN ~a" channel)) - channels)) - (define (startswith-colon? str) (and (> (string-length str) 0) (eq? (string-ref str 0) #\:))) -(define-record-type - (make-irc-line prefix command params) - irc-line? - (prefix irc-line-prefix) - (command irc-line-command) - (params irc-line-params)) - - +;; TODO: This needs a cleanup. Maybe even just using a regex is fine. (define (parse-line line) (define (parse-params pre-params) ;; This is stupid and imperative but I can't wrap my brain around @@ -156,11 +92,11 @@ (((? startswith-colon? prefix) command pre-params ...) - (make-irc-line prefix command - (parse-params pre-params))) + (values prefix command + (parse-params pre-params))) ((command pre-params ...) - (make-irc-line #f command - (parse-params pre-params))))) + (values #f command + (parse-params pre-params))))) (define (strip-colon-if-necessary string) (if (and (> (string-length string) 0) @@ -169,8 +105,8 @@ string)) ;; @@: Not sure if this works in all cases, like what about in a non-privmsg one? -(define (irc-line-username irc-line) - (let* ((prefix-name (strip-colon-if-necessary (irc-line-prefix irc-line))) +(define (irc-line-username irc-line-prefix) + (let* ((prefix-name (strip-colon-if-necessary irc-line-prefix)) (exclaim-index (string-index prefix-name #\!))) (if exclaim-index (substring/copy prefix-name 0 exclaim-index) @@ -178,7 +114,7 @@ (define (condense-privmsg-line line) "Condense message line and do multiple value return of - (channel message is-action)" + (channel message emote?)" (define (strip-last-char string) (substring/copy string 0 (- (string-length string) 1))) (let* ((channel-name (caar line)) @@ -195,112 +131,106 @@ (string-join (cons first-word rest-message) " ") #f))))) -(define (echo-back-message socket my-name speaker - channel-name message is-action) - (if is-action +;;; A goofy default +(define (echo-message irc-bot speaker channel-name + line-text emote?) + "Simply echoes the message to the current-output-port." + (if emote? (format #t "~a emoted ~s in channel ~a\n" - speaker message channel-name) + speaker line-text channel-name) (format #t "~a said ~s in channel ~a\n" - speaker message channel-name))) - -(define default-handle-privmsg echo-back-message) - -(define* (make-handle-line #:key - (handle-privmsg default-handle-privmsg)) - (define (handle-line socket line my-username) - (let ((parsed-line (parse-line line))) - (match (irc-line-command parsed-line) - ("PING" - (irc-display "PONG" socket)) - ("PRIVMSG" - (receive (channel-name message is-action) - (condense-privmsg-line (irc-line-params parsed-line)) - (let ((username (irc-line-username parsed-line))) - (handle-privmsg socket my-username username - channel-name message is-action)))) - (_ - (display line) - (newline))))) - handle-line) - -(define (irc-loop socket handle-line username) - (define (loop) - (define line (string-trim-right (read-line socket) #\return)) - (handle-line socket line username) - (cond - ;; The port's been closed for some reason, so stop looping - ((port-closed? socket) - 'done) - ;; We've reached the EOF object, which means we should close - ;; the port ourselves and stop looping - ((eof-object? (peek-char socket)) - (close socket) - 'done) - ;; Otherwise, let's read till the next line! - (else (loop)))) - (loop)) - -(define default-line-handler (make-handle-line)) - -(define* (queue-and-start-irc-agenda! agenda socket #:key - (username "syncbot") - (inet-port default-irc-port) - (line-handler default-line-handler) - (channels '())) - (dynamic-wind - (lambda () #f) - (lambda () - (enq! (agenda-queue agenda) - (wrap (irc-loop socket line-handler username))) - (enq! (agenda-queue agenda) (wrap (handle-login socket username - #:channels channels))) - (start-agenda agenda)) - (lambda () - (display "Cleaning up...\n") - (close socket)))) - + speaker line-text channel-name))) -;;; CLI +;;; Bot ;;; === -(define option-spec - `((server (single-char #\s) (required? #t) (value #t)) - (port (single-char #\p) - (value #t) - (predicate - ,(lambda (s) - (if (string->number s) #t #f)))) - (username (single-char #\u) (required? #t) (value #t)) - (channels (value #t)) - (listen))) +(define-class () + (username #:init-keyword #:username + #:getter irc-bot-username) + (realname #:init-keyword #:realname + #:init-value #f) + (server #:init-keyword #:server + #:getter irc-bot-server) + (channels #:init-keyword #:channels + #:getter irc-bot-channels) + (port #:init-keyword #:port + #:init-value default-irc-port + #:getter irc-bot-port) + (line-handler #:init-keyword #:line-handler + #:init-value (wrap-apply echo-message) + #:getter irc-bot-line-handler) + (socket #:accessor irc-bot-socket) + (actions #:allocation #:each-subclass + #:init-value (build-actions + (init irc-bot-init) + (main-loop irc-bot-main-loop) + (send-line irc-bot-send-line)))) + +(define (irc-bot-realname irc-bot) + (or (slot-ref irc-bot 'realname) + (irc-bot-username irc-bot))) + +(define (irc-bot-init irc-bot message) + "Initialize the IRC bot" + (define socket + (irc-socket-setup (irc-bot-server irc-bot) + (irc-bot-port irc-bot))) + (set! (irc-bot-socket irc-bot) socket) + (format socket "USER ~a ~a ~a :~a~a" + (irc-bot-username irc-bot) + "*" "*" ; hostname and servername + (irc-bot-realname irc-bot) irc-eol) + (format socket "NICK ~a~a" (irc-bot-username irc-bot) irc-eol) -(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)) - (port (or (option-ref options 'port #f) - default-irc-port)) - (username (option-ref options 'username #f)) - (listen (option-ref options 'listen #f)) - (channels (option-ref options 'channels "")) - (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) - (if listen - (spawn-and-queue-repl-server! agenda)) - (queue-and-start-irc-agenda! - agenda - (irc-socket-setup hostname port) - #:inet-port port - #:username username - #:channels (string-split channels #\space) - #:line-handler line-handler))) - main) - -(define main (make-irc-bot-cli)) + (for-each + (lambda (channel) + (format socket "JOIN ~a~a" channel irc-eol)) + (irc-bot-channels irc-bot)) + + (<- irc-bot (actor-id irc-bot) 'main-loop)) + +(define (irc-bot-main-loop irc-bot message) + (define socket (irc-bot-socket irc-bot)) + (define line (string-trim-right (read-line socket) #\return)) + (irc-bot-dispatch-line irc-bot line) + (cond + ;; The port's been closed for some reason, so stop looping + ((port-closed? socket) + 'done) + ;; We've reached the EOF object, which means we should close + ;; the port ourselves and stop looping + ((eof-object? (peek-char socket)) + (close socket) + 'done) + ;; ;; Looks like we've been killed somehow... well, stop running + ;; ;; then! + ;; ((actor-am-i-dead? irc-bot) + ;; (if (not (port-closed? socket)) + ;; (close socket)) + ;; 'done) + ;; Otherwise, let's read till the next line! + (else + (<- irc-bot (actor-id irc-bot) 'main-loop)))) + +(define-method (irc-bot-dispatch-line (irc-bot ) line) + (receive (line-prefix line-command line-params) + (parse-line line) + (match line-command + ("PING" + (display "PONG" (irc-bot-socket irc-bot))) + ("PRIVMSG" + (receive (channel-name line-text emote?) + (condense-privmsg-line line-params) + (let ((username (irc-line-username line-prefix))) + ((irc-bot-line-handler irc-bot) irc-bot username + channel-name line-text emote?)))) + (_ + (display line) + (newline))))) + +(define* (irc-bot-send-line irc-bot message + channel line #:key emote?) + ;; TODO: emote? handling + (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a" + channel line irc-eol)) diff --git a/demos/ircbot.scm b/demos/ircbot.scm index 49b241f..ec381f0 100755 --- a/demos/ircbot.scm +++ b/demos/ircbot.scm @@ -20,36 +20,97 @@ ;;; You should have received a copy of the GNU Lesser General Public ;;; License along with 8sync. If not, see . -(use-modules (8sync systems irc) - (8sync agenda) +(use-modules (8sync) + (8sync systems irc) + (srfi srfi-37) (ice-9 match)) -(define (handle-message socket my-name speaker - channel message is-action) +(define (handle-line irc-bot speaker channel line emote?) + (define my-name (irc-bot-username irc-bot)) (define (looks-like-me? str) (or (equal? str my-name) (equal? str (string-concatenate (list my-name ":"))))) - (match (string-split message #\space) + (match (string-split line #\space) (((? looks-like-me? _) action action-args ...) (match action + ;; The classic botsnack! ("botsnack" - (irc-format socket "PRIVMSG ~a :Yippie! *does a dance!*" channel)) + (<- irc-bot (actor-id irc-bot) 'send-line channel + "Yippie! *does a dance!*")) + ;; Return greeting ((or "hello" "hello!" "hello." "greetings" "greetings." "greetings!" - "hei" "hei." "hei!") - (irc-format socket "PRIVMSG ~a :Oh hi ~a!" channel speaker)) - ;; Add yours here + "hei" "hei." "hei!" "hi" "hi!") + (<- irc-bot (actor-id irc-bot) 'send-line channel + (format #f "Oh hi ~a!" speaker))) + + ;; ---> Add yours here <--- + + ;; Default (_ - (irc-format socket "PRIVMSG ~a :*stupid puppy look*" channel)))) + (<- irc-bot (actor-id irc-bot) 'send-line channel + "*stupid puppy look*")))) + ;; Otherwise... just spit the output to current-output-port or whatever (_ - (cond - (is-action - (format #t "~a emoted ~s in channel ~a\n" - speaker message channel)) - (else - (format #t "~a said ~s in channel ~a\n" - speaker message channel)))))) - -(define main - (make-irc-bot-cli (make-handle-line - #:handle-privmsg (wrap-apply handle-message)))) + (if emote? + (format #t "~a emoted ~s in channel ~a\n" + speaker line channel) + (format #t "~a said ~s in channel ~a\n" + speaker line channel))))) + + +(define (display-help scriptname) + (format #t "Usage: ~a [OPTION] username" scriptname) + (display " + -h, --help display this text + --server=SERVER-NAME connect to SERVER-NAME + defaults to \"irc.freenode.net\" + --channels=CHANNEL1,CHANNEL2 + join comma-separated list of channels on connect + defaults to \"##botchat\"") + (newline)) + +(define (parse-args scriptname args) + (args-fold (cdr args) + (list (option '(#\h "help") #f #f + (lambda _ + (display-help scriptname) + (exit 0))) + (option '("server") #t #f + (lambda (opt name arg result) + `(#:server ,arg ,@result))) + (option '("channels") #t #f + (lambda (opt name arg result) + `(#:channels ,(string-split arg #\,) + ,@result)))) + (lambda (opt name arg result) + (format #t "Unrecognized option `~a'\n" name) + (exit 1)) + (lambda (option result) + `(#:username ,option ,@result)) + '())) + +(define* (run-bot #:key (username "examplebot") + (server "irc.freenode.net") + (channels '("##botchat")) + (repl #f)) + (define hive (make-hive)) + (define irc-bot + (hive-create-actor* hive "irc-bot" + #:line-handler handle-line + ;; TODO: move these to argument parsing + #:username username + #:server server + #:channels channels)) + ;; TODO: load REPL + (ez-run-hive hive (list (bootstrap-message hive irc-bot 'init)))) +(define (main args) + (define parsed-args (parse-args "ircbot.scm" (pk 'args args))) + (apply (lambda* (#:key username #:allow-other-keys) + (when (not username) + (display "Error: username not specified!") + (newline) (newline) + (display-help "ircbot.scm") + (exit 1))) + parsed-args) + (apply run-bot parsed-args)) -- 2.31.1 From bc24c9f3f29d3396ae9e52f9682914dec868838a Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Fri, 23 Dec 2016 14:22:28 -0600 Subject: [PATCH 09/16] irc: Move irc-bot code to make use of generic methods ircbot.scm demo also now makes use of subclassing. * 8sync/systems/irc.scm (): Removed line-handler field. (irc-bot-dispatch-line): Renamed from irc-bot-dispatch-raw-line. All callers changed. (irc-bot-send-line): Moved position in file. (irc-bot-handle-line): New method. (irc-bot-handle-misc-input, irc-bot-handle-user-join) (irc-bot-handle-user-quit): New stub methods. * demos/ircbot.scm (): New variable. (irc-bot-handle-line): Now a generic method extending same named method in 8sync/systems/irc.scm. Previously was `handle-line'. (run-bot): Use . (main): Remove debugging pk. --- 8sync/systems/irc.scm | 51 ++++++++++++++++++++++++++++--------------- demos/ircbot.scm | 12 +++++----- 2 files changed, 40 insertions(+), 23 deletions(-) diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm index e912e5f..01a83c8 100755 --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -33,8 +33,10 @@ #:use-module (ice-9 match) #:use-module (oop goops) #:export ( - irc-bot-username irc-bot-server irc-bot-channels - irc-bot-port irc-bot-handler + irc-bot-username irc-bot-server irc-bot-channels irc-bot-port + + irc-bot-handle-line irc-bot-handle-misc-input + irc-bot-handle-user-join irc-bot-handle-user-quit default-irc-port)) @@ -157,9 +159,6 @@ (port #:init-keyword #:port #:init-value default-irc-port #:getter irc-bot-port) - (line-handler #:init-keyword #:line-handler - #:init-value (wrap-apply echo-message) - #:getter irc-bot-line-handler) (socket #:accessor irc-bot-socket) (actions #:allocation #:each-subclass #:init-value (build-actions @@ -193,7 +192,7 @@ (define (irc-bot-main-loop irc-bot message) (define socket (irc-bot-socket irc-bot)) (define line (string-trim-right (read-line socket) #\return)) - (irc-bot-dispatch-line irc-bot line) + (irc-bot-dispatch-raw-line irc-bot line) (cond ;; The port's been closed for some reason, so stop looping ((port-closed? socket) @@ -213,9 +212,18 @@ (else (<- irc-bot (actor-id irc-bot) 'main-loop)))) -(define-method (irc-bot-dispatch-line (irc-bot ) line) +(define* (irc-bot-send-line irc-bot message + channel line #:key emote?) + ;; TODO: emote? handling + (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a" + channel line irc-eol)) + +;;; Likely-to-be-overridden generic methods + +(define-method (irc-bot-dispatch-raw-line (irc-bot ) raw-line) + "Dispatch a raw line of input" (receive (line-prefix line-command line-params) - (parse-line line) + (parse-line raw-line) (match line-command ("PING" (display "PONG" (irc-bot-socket irc-bot))) @@ -223,14 +231,21 @@ (receive (channel-name line-text emote?) (condense-privmsg-line line-params) (let ((username (irc-line-username line-prefix))) - ((irc-bot-line-handler irc-bot) irc-bot username - channel-name line-text emote?)))) - (_ - (display line) - (newline))))) + (irc-bot-handle-line irc-bot username channel-name + line-text emote?)))) + (_ (irc-bot-handle-misc-input irc-bot raw-line))))) + +(define-method (irc-bot-handle-line (irc-bot ) username channel-name + line-text emote?) + (echo-message irc-bot username channel-name line-text emote?)) + +(define-method (irc-bot-handle-misc-input (irc-bot ) raw-line) + (display raw-line) + (newline)) + +(define-method (irc-bot-handle-user-join (irc-bot ) user channel) + 'TODO) + +(define-method (irc-bot-handle-user-quit (irc-bot ) user channel) + 'TODO) -(define* (irc-bot-send-line irc-bot message - channel line #:key emote?) - ;; TODO: emote? handling - (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a" - channel line irc-eol)) diff --git a/demos/ircbot.scm b/demos/ircbot.scm index ec381f0..bfcd723 100755 --- a/demos/ircbot.scm +++ b/demos/ircbot.scm @@ -22,10 +22,14 @@ (use-modules (8sync) (8sync systems irc) + (oop goops) (srfi srfi-37) (ice-9 match)) -(define (handle-line irc-bot speaker channel line emote?) +(define-class ()) + +(define-method (irc-bot-handle-line (irc-bot ) speaker channel + line emote?) (define my-name (irc-bot-username irc-bot)) (define (looks-like-me? str) (or (equal? str my-name) @@ -95,9 +99,7 @@ (repl #f)) (define hive (make-hive)) (define irc-bot - (hive-create-actor* hive "irc-bot" - #:line-handler handle-line - ;; TODO: move these to argument parsing + (hive-create-actor* hive "irc-bot" #:username username #:server server #:channels channels)) @@ -105,7 +107,7 @@ (ez-run-hive hive (list (bootstrap-message hive irc-bot 'init)))) (define (main args) - (define parsed-args (parse-args "ircbot.scm" (pk 'args args))) + (define parsed-args (parse-args "ircbot.scm" args)) (apply (lambda* (#:key username #:allow-other-keys) (when (not username) (display "Error: username not specified!") -- 2.31.1 From 165231476f466b4dbeca51c981cf0dfa2963ff16 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Fri, 23 Dec 2016 15:19:08 -0600 Subject: [PATCH 10/16] irc: Shorten generic method names. * 8sync/systems/irc.scm: (handle-line, handle-misc-input) (handle-user-join, handle-user-quit): Shorten names from their previous irc-bot-* longer names. Update callers. * demos/ircbot.scm: Update callers to above. --- 8sync/systems/irc.scm | 16 ++++++++-------- demos/ircbot.scm | 4 ++-- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm index 01a83c8..536c9a2 100755 --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -35,8 +35,8 @@ #:export ( irc-bot-username irc-bot-server irc-bot-channels irc-bot-port - irc-bot-handle-line irc-bot-handle-misc-input - irc-bot-handle-user-join irc-bot-handle-user-quit + handle-line handle-misc-input + handle-user-join handle-user-quit default-irc-port)) @@ -192,7 +192,7 @@ (define (irc-bot-main-loop irc-bot message) (define socket (irc-bot-socket irc-bot)) (define line (string-trim-right (read-line socket) #\return)) - (irc-bot-dispatch-raw-line irc-bot line) + (dispatch-raw-line irc-bot line) (cond ;; The port's been closed for some reason, so stop looping ((port-closed? socket) @@ -220,7 +220,7 @@ ;;; Likely-to-be-overridden generic methods -(define-method (irc-bot-dispatch-raw-line (irc-bot ) raw-line) +(define-method (dispatch-raw-line (irc-bot ) raw-line) "Dispatch a raw line of input" (receive (line-prefix line-command line-params) (parse-line raw-line) @@ -235,17 +235,17 @@ line-text emote?)))) (_ (irc-bot-handle-misc-input irc-bot raw-line))))) -(define-method (irc-bot-handle-line (irc-bot ) username channel-name +(define-method (handle-line (irc-bot ) username channel-name line-text emote?) (echo-message irc-bot username channel-name line-text emote?)) -(define-method (irc-bot-handle-misc-input (irc-bot ) raw-line) +(define-method (handle-misc-input (irc-bot ) raw-line) (display raw-line) (newline)) -(define-method (irc-bot-handle-user-join (irc-bot ) user channel) +(define-method (handle-user-join (irc-bot ) user channel) 'TODO) -(define-method (irc-bot-handle-user-quit (irc-bot ) user channel) +(define-method (handle-user-quit (irc-bot ) user channel) 'TODO) diff --git a/demos/ircbot.scm b/demos/ircbot.scm index bfcd723..48fc6b7 100755 --- a/demos/ircbot.scm +++ b/demos/ircbot.scm @@ -28,8 +28,8 @@ (define-class ()) -(define-method (irc-bot-handle-line (irc-bot ) speaker channel - line emote?) +(define-method (handle-line (irc-bot ) speaker channel + line emote?) (define my-name (irc-bot-username irc-bot)) (define (looks-like-me? str) (or (equal? str my-name) -- 2.31.1 From 382af9f4ada1170faab3efda78ae5e3b5e1d4d42 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 24 Dec 2016 11:58:37 -0600 Subject: [PATCH 11/16] irc: Fixing "PONG" response, calls to handle-foo commands. * 8sync/systems/irc.scm (dispatch-raw-line): Append irc-eol to PONG response. Fix calls to hanle-line and handle-misc-input, which recently were renamed. --- 8sync/systems/irc.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm index 536c9a2..495cbca 100755 --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -226,14 +226,15 @@ (parse-line raw-line) (match line-command ("PING" - (display "PONG" (irc-bot-socket irc-bot))) + (display (string-append "PONG" irc-eol) + (irc-bot-socket irc-bot))) ("PRIVMSG" (receive (channel-name line-text emote?) (condense-privmsg-line line-params) (let ((username (irc-line-username line-prefix))) - (irc-bot-handle-line irc-bot username channel-name - line-text emote?)))) - (_ (irc-bot-handle-misc-input irc-bot raw-line))))) + (handle-line irc-bot username channel-name + line-text emote?)))) + (_ (handle-misc-input irc-bot raw-line))))) (define-method (handle-line (irc-bot ) username channel-name line-text emote?) -- 2.31.1 From 7b3f08078664ba2a09d204fe175b5b80f497b44f Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 24 Dec 2016 13:06:12 -0600 Subject: [PATCH 12/16] actors: Update actor ids to use a vector rather than a cons cell. This is a bit easier to read when read/written, and should be comparatively efficient. * 8sync/actors.scm (make-address, address-actor-id, address-hive-id): Update to use a vector rather than a cons cell. --- 8sync/actors.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/8sync/actors.scm b/8sync/actors.scm index 9b079b8..2c7381d 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -322,13 +322,13 @@ raise an exception if an error." ;; (define (make-address actor-id hive-id) - (cons actor-id hive-id)) + (vector actor-id hive-id)) (define (address-actor-id address) - (car address)) + (vector-ref address 0)) (define (address-hive-id address) - (cdr address)) + (vector-ref address 1)) (define (address->string address) (string-append (address-actor-id address) "@" -- 2.31.1 From 88ad8bc99a14d0037bad27ff3c576ebbabbf14f4 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 24 Dec 2016 13:09:54 -0600 Subject: [PATCH 13/16] irc: Split irc-bot-send-line into main functionality and action handler. This allows irc-bot-send-line to be called directly. * 8sync/systems/irc.scm (irc-bot-send-line): Update this procedure to not have a message as one of the arguments so it can be called directly. (irc-bot-send-line-action): Action handler, doing what irc-bot-send-line previously did. (): Update actions mapping to point to irc-bot-send-line-action. --- 8sync/systems/irc.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/8sync/systems/irc.scm b/8sync/systems/irc.scm index 495cbca..aad138d 100755 --- a/8sync/systems/irc.scm +++ b/8sync/systems/irc.scm @@ -35,6 +35,8 @@ #:export ( irc-bot-username irc-bot-server irc-bot-channels irc-bot-port + irc-bot-send-line + handle-line handle-misc-input handle-user-join handle-user-quit @@ -164,7 +166,7 @@ #:init-value (build-actions (init irc-bot-init) (main-loop irc-bot-main-loop) - (send-line irc-bot-send-line)))) + (send-line irc-bot-send-line-action)))) (define (irc-bot-realname irc-bot) (or (slot-ref irc-bot 'realname) @@ -212,12 +214,18 @@ (else (<- irc-bot (actor-id irc-bot) 'main-loop)))) -(define* (irc-bot-send-line irc-bot message - channel line #:key emote?) +(define* (irc-bot-send-line-action irc-bot message + channel line #:key emote?) + "Action handler for sending lines. Real behavior happens in +irc-bot-send-line." + (irc-bot-send-line irc-bot channel line #:emote? emote?)) + +(define* (irc-bot-send-line irc-bot channel line #:key emote?) ;; TODO: emote? handling (format (irc-bot-socket irc-bot) "PRIVMSG ~a :~a~a" channel line irc-eol)) + ;;; Likely-to-be-overridden generic methods (define-method (dispatch-raw-line (irc-bot ) raw-line) -- 2.31.1 From beafb0205f14434bb5fdc6b023b5dd3ffea320e5 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 24 Dec 2016 13:55:47 -0600 Subject: [PATCH 14/16] doc: Drafting a new manual. * doc/8sync-new-manual.org: New file. This is a temporary location for manual contents while ideas for the manual are being spelled out. --- doc/8sync-new-manual.org | 92 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 doc/8sync-new-manual.org diff --git a/doc/8sync-new-manual.org b/doc/8sync-new-manual.org new file mode 100644 index 0000000..b352a2b --- /dev/null +++ b/doc/8sync-new-manual.org @@ -0,0 +1,92 @@ +# Permission is granted to copy, distribute and/or modify this document +# under the terms of the GNU Free Documentation License, Version 1.3 +# or any later version published by the Free Software Foundation; +# with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. +# A copy of the license is included in the section entitled ``GNU +# Free Documentation License''. +# +# A copy of the license is also available from the Free Software +# Foundation Web site at http://www.gnu.org/licenses/fdl.html +# +# Altenately, this document is also available under the Lesser General +# Public License, version 3 or later, as published by the Free Software +# Foundation. +# +# A copy of the license is also available from the Free Software +# Foundation Web site at http://www.gnu.org/licenses/lgpl.html + +* Preface + +Welcome to 8sync's documentation! +8sync is an asynchronous programming environment for GNU Guile. +(Get it? 8sync? Async??? Quiet your groans, it's a great name!) + +8sync has some nice properties: + + - 8sync uses the actor model as its fundamental concurrency + synchronization mechanism. + Since the actor model is a "shared nothing" asynchronous + environment, you don't need to worry about deadlocks or other + tricky problems common to other asynchronous models. + Actors are modular units of code and state which communicate + by sending messages to each other. + - If you've done enough asynchronous programming, you're probably + familiar with the dreaded term "callback hell". + Getting around callback hell usually involves a tradeoff of other, + still rather difficult to wrap your brain around programming + patterns. + 8sync uses some clever tricks involving "delimited continuations" + under the hood to make the code you write look familiar and + straightforward. + When you need to send a request to another actor and get some + information back from it without blocking, there's no need + to write a separate procedure... 8sync's scheduler will suspend + your procedure and wake it back up when a response is ready. + - Even nonblocking I/O code is straightforward to write. + Thanks to the "suspendable ports" code introduced in Guile 2.2, + writing asynchronous, nonblocking networked code looks mostly + like writing the same synchronous code. + 8sync's scheduler handles suspending and resuming networked + code that would otherwise block. + - 8sync aims to be "batteries included". + Useful subsystems for IRC bots, HTTP servers, and so on are + included out of the box. + - 8sync prioritizes live hacking. + If using an editor like Emacs with a nice mode like Geiser, + an 8sync-using developer can change and fine-tune the behavior + of code /while it runs/. + This makes both debugging and development much more natural, + allowing the right designs to evolve under your fingertips. + A productive hacker is a happy hacker, after all! + +In the future, 8sync will also provide the ability to spawn and +communicate with actors on different threads, processes, and machines, +with most code running the same as if actors were running in the same +execution environment. + +But as a caution, 8sync is still very young. +The API is stabilizing, but not yet stable, and it is not yet well +"battle-tested". +Hacker beware! +But, consider this as much an opportunity as a warning. +8sync is in a state where there is much room for feedback and +contributions. +Your help wanted! + +And now, into the wild, beautiful frontier. +Onward! + +* Tutorial + +** Intro to the tutorial + +** A fun little IRC bot + +** Battle bot! + +** Adding a "rankings" web page + +** Writing our own from scratch + +* API reference + -- 2.31.1 From 3980bf3b22b75fa51fe514f9a38f4d7232843fe2 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 24 Dec 2016 22:59:29 -0600 Subject: [PATCH 15/16] doc: Add tutorial intro to the new manual. * doc/8sync-new-manual.org: Fill in "Intro to the tutorial" section. --- doc/8sync-new-manual.org | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/doc/8sync-new-manual.org b/doc/8sync-new-manual.org index b352a2b..0115003 100644 --- a/doc/8sync-new-manual.org +++ b/doc/8sync-new-manual.org @@ -80,7 +80,41 @@ Onward! ** Intro to the tutorial -** A fun little IRC bot +IRC! Internet Relay Chat! +The classic chat protocol of the Internet. +And it turns out, one of the best places to learn about networked +programming. + +In the 1990s I remember stumbling into some funky IRC chat rooms and +being astounded that people there had what they called "bots" hanging +around. +From then until now, I've always enjoyed encountering bots whose range +of functionality has spanned from saying absurd things, to taking +messages when their "owners" were offline, to reporting the weather, +to logging meetings for participants. +And it turns out, IRC bots are a great way to cut your teeth on +networked programming; since IRC is a fairly simple line-delineated +protocol, it's a great way to learn to interact with sockets. +(My first IRC bot helped my team pick a place to go to lunch, previously +a source of significant dispute!) +At the time of writing, venture capital awash startups are trying to +turn chatbots into "big business"... a strange (and perhaps absurd) +thing given chat bots being a fairly mundane novelty amongst hackers +and teenagers everywhere in the 1990s. + +We ourselves are going to explore chat bots as a basis for getting our +feet wet in 8sync. +We'll start from a minimalist example using an irc bot with most of +the work done for us, then move on to constructing our own actors as +"game pieces" which interface with our bot, then experiment with just +how easy it is to add new networked layers by tacking on a high score +to our game, and as a finale we'll dive into writing our own little +irc bot framework "from scratch" on top of the 8sync actor model. + +Alright, let's get going. +This should be a lot of fun! + +** A silly little IRC bot ** Battle bot! -- 2.31.1 From 702d8f3a4f6b6abdf7e5c258a39f78eb4f0bb575 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sun, 25 Dec 2016 09:21:44 -0600 Subject: [PATCH 16/16] demos: Import format in ircbot.scm. * demos/ircbot.scm: Import "(ice-9 format)". --- demos/ircbot.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/demos/ircbot.scm b/demos/ircbot.scm index 48fc6b7..b97b572 100755 --- a/demos/ircbot.scm +++ b/demos/ircbot.scm @@ -24,6 +24,7 @@ (8sync systems irc) (oop goops) (srfi srfi-37) + (ice-9 format) (ice-9 match)) (define-class ()) -- 2.31.1