X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=demos%2Firc.scm;h=b6a992cdf19e5be2148b7a8e92ec4f22e3728f0b;hb=dc1207c53397653cb606c21638d0ad871431ea3a;hp=cbd3848378f8d8adb3748e0abe66b18e50921507;hpb=acafaeee5bba662ce9bb37744ee75e0c461c628d;p=8sync.git diff --git a/demos/irc.scm b/demos/irc.scm index cbd3848..b6a992c 100755 --- a/demos/irc.scm +++ b/demos/irc.scm @@ -21,6 +21,7 @@ (use-modules (eightsync repl) (eightsync agenda) + (srfi srfi-9) (ice-9 getopt-long) (ice-9 format) (ice-9 q) @@ -78,14 +79,70 @@ (irc-format socket "JOIN ~a" channel)) channels)) -(define (handle-line socket line my-username) +(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)) + + +(define (parse-line line) + (define (parse-params pre-params) + ;; This is stupid and imperative but I can't wrap my brain around + ;; the right way to do it in a functional way :\ + (let ((param-list '()) + (currently-building '())) + (for-each + (lambda (param-item) + (cond + ((startswith-colon? param-item) + (if (not (eq? currently-building '())) + (set! param-list + (cons + (reverse currently-building) + param-list))) + (set! currently-building (list param-item))) + (else + (set! currently-building (cons param-item currently-building))))) + pre-params) + ;; We're still building something, so tack that on there + (if (not (eq? currently-building '())) + (set! param-list + (cons (reverse currently-building) param-list))) + ;; return the reverse of the param list + (reverse param-list))) + (match (string-split line #\space) - (("PING" rest ...) - (irc-display "PONG" socket) - (display "PONG'ed back ;)\n")) - (_ - (display line) - (newline)))) + (((? startswith-colon? prefix) + command + pre-params ...) + (make-irc-line prefix command + (parse-params pre-params))) + ((command pre-params ...) + (make-irc-line #f command + (parse-params pre-params))))) + + +(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" + (display "hey we got a PRIVMSG up in here!\n") + (display parsed-line) + (newline) + (display line) + (newline)) + (_ + (display line) + (newline))))) (define (make-simple-irc-handler handle-line username) (let ((buffer '()))