ec381f0b83ea3b03b356fdc9e3b6eaed85a270a6
[8sync.git] / demos / ircbot.scm
1 #!/usr/bin/guile \
2 -e main -s
3 !#
4
5 ;;; 8sync --- Asynchronous programming for Guile
6 ;;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
7 ;;;
8 ;;; This file is part of 8sync.
9 ;;;
10 ;;; 8sync is free software: you can redistribute it and/or modify it
11 ;;; under the terms of the GNU Lesser General Public License as
12 ;;; published by the Free Software Foundation, either version 3 of the
13 ;;; License, or (at your option) any later version.
14 ;;;
15 ;;; 8sync is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;;; GNU Lesser General Public License for more details.
19 ;;;
20 ;;; You should have received a copy of the GNU Lesser General Public
21 ;;; License along with 8sync.  If not, see <http://www.gnu.org/licenses/>.
22
23 (use-modules (8sync)
24              (8sync systems irc)
25              (srfi srfi-37)
26              (ice-9 match))
27
28 (define (handle-line irc-bot speaker channel line emote?)
29   (define my-name (irc-bot-username irc-bot))
30   (define (looks-like-me? str)
31     (or (equal? str my-name)
32         (equal? str (string-concatenate (list my-name ":")))))
33   (match (string-split line #\space)
34     (((? looks-like-me? _) action action-args ...)
35      (match action
36        ;; The classic botsnack!
37        ("botsnack"
38         (<- irc-bot (actor-id irc-bot) 'send-line channel
39             "Yippie! *does a dance!*"))
40        ;; Return greeting
41        ((or "hello" "hello!" "hello." "greetings" "greetings." "greetings!"
42             "hei" "hei." "hei!" "hi" "hi!")
43         (<- irc-bot (actor-id irc-bot) 'send-line channel
44             (format #f "Oh hi ~a!" speaker)))
45
46        ;; --->  Add yours here <---
47
48        ;; Default
49        (_
50         (<- irc-bot (actor-id irc-bot) 'send-line channel
51             "*stupid puppy look*"))))
52     ;; Otherwise... just spit the output to current-output-port or whatever
53     (_
54      (if emote?
55          (format #t "~a emoted ~s in channel ~a\n"
56                  speaker line channel)
57          (format #t "~a said ~s in channel ~a\n"
58                  speaker line channel)))))
59
60
61 (define (display-help scriptname)
62   (format #t "Usage: ~a [OPTION] username" scriptname)
63   (display "
64   -h, --help                  display this text
65       --server=SERVER-NAME    connect to SERVER-NAME
66                                 defaults to \"irc.freenode.net\"
67       --channels=CHANNEL1,CHANNEL2
68                               join comma-separated list of channels on connect
69                                 defaults to \"##botchat\"")
70   (newline))
71
72 (define (parse-args scriptname args)
73   (args-fold (cdr args)
74              (list (option '(#\h "help") #f #f
75                            (lambda _
76                              (display-help scriptname)
77                              (exit 0)))
78                    (option '("server") #t #f
79                            (lambda (opt name arg result)
80                              `(#:server ,arg ,@result)))
81                    (option '("channels") #t #f
82                            (lambda (opt name arg result)
83                              `(#:channels ,(string-split arg #\,)
84                                ,@result))))
85              (lambda (opt name arg result)
86                (format #t "Unrecognized option `~a'\n" name)
87                (exit 1))
88              (lambda (option result)
89                `(#:username ,option ,@result))
90              '()))
91
92 (define* (run-bot #:key (username "examplebot")
93                   (server "irc.freenode.net")
94                   (channels '("##botchat"))
95                   (repl #f))
96   (define hive (make-hive))
97   (define irc-bot
98     (hive-create-actor* hive <irc-bot> "irc-bot"
99                         #:line-handler handle-line
100                         ;; TODO: move these to argument parsing
101                         #:username username
102                         #:server server
103                         #:channels channels))
104   ;; TODO: load REPL
105   (ez-run-hive hive (list (bootstrap-message hive irc-bot 'init))))
106
107 (define (main args)
108   (define parsed-args (parse-args "ircbot.scm" (pk 'args args)))
109   (apply (lambda* (#:key username #:allow-other-keys)
110            (when (not username)
111              (display "Error: username not specified!")
112              (newline) (newline)
113              (display-help "ircbot.scm")
114              (exit 1)))
115          parsed-args)
116   (apply run-bot parsed-args))