;; Botbot: Very basic IRC bot

(import (chicken io)
        (chicken port)
        (chicken file)
        (chicken string)
        (chicken pathname)
        (chicken process-context)
        (chicken irregex)
        matchable srfi-13 srfi-1
        uri-common tcp6 openssl)

;; Globals

(define nick "botbot")
(define username "#phloggersgarage bot")

(tcp-read-timeout #f) ;disable read timeout

(define (launch-bot host port)
  (let-values (((in-port out-port) (tcp-connect host port)))
    ;; Connect to server
    (if (establish-connection in-port out-port)
        ;; (bot-loop in-port out-port)
        (begin
          (print "Successfully connected!")
          (bot-loop in-port out-port))
        (print "Failed to establish connection. Aborting..."))))

(define (establish-connection in-port out-port)
  (write-msg `(#f #f "NICK" (,nick)) out-port)
  (write-msg `(#f #f "USER" (,nick "0" "*" ,username)) out-port)
  (let ((msg (read-msg in-port)))
    (print msg)
    (string=? (msg-command msg) "001")))

(define (bot-loop in-port out-port)
  (let loop ((msg (read-msg in-port)))
    (match (cons (msg-source msg) (cons (msg-command msg) (msg-args msg)))
      ((_ "PING" token)
       (write-msg `(#f #f "PONG" (,token)) out-port))
      ((source "PRIVMSG" target args ...)
       (when (string=? target nick)
         (print "Someone sent me this message: " args)
         (write-msg `(#f #f "PRIVMSG" (,source "Message received!")) out-port)))
      (_
       ; Do nothing
       ))
    (loop (read-msg in-port))))

(define (read-msg in-port)
  (let ((msg (string->msg (read-line in-port))))
    (print "Received message: " msg)
    msg))

(define (write-msg msg out-port)
  (with-output-to-port out-port
    (lambda () (write-string (conc (msg->string msg) "\r\n"))))
  (print "Sent message: " msg))

(define msg-regex
  (irregex '(:
             (? (: "@" (submatch (+ (~ " "))) (* " ")))
             (? (: ":" (submatch (+ (~ " " "!" "@")))
                   (* (~ " "))          ;discard non-nick portion
                   (* " ")))
             (submatch (+ (~ " ")))
             (* " ")
             (? (submatch (+ any))))))

(define (string->msg string)
  (let ((match  (irregex-match msg-regex string)))
    (list
     (irregex-match-substring match 1) ; Tags
     (irregex-match-substring match 2) ; Source
     (string-upcase (irregex-match-substring match 3)) ; command
     (parse-message-args (irregex-match-substring match 4))))) ;args

(define (msg->string msg)
  (conc
   (msg-command msg)
   (let ((args (msg-args msg)))
     (if args (conc " " (make-arg-string args)) ""))))

(define (make-arg-string args)
  (let* ((revargs (reverse args))
         (final-arg (car revargs))
         (first-args (reverse (cdr revargs))))
    (conc (string-join first-args " ")
          " :" final-arg)))

(define (parse-message-args argstr)
  (if argstr
      (let ((first-split (string-split argstr ":")))
        (if (null? first-split)
            #f
            (append
             (string-split (car first-split) " ")
             (cdr first-split))))))

(define (msg-tags msg) (list-ref msg 0))
(define (msg-source msg) (list-ref msg 1))
(define (msg-command msg) (list-ref msg 2))
(define (msg-args msg) (list-ref msg 3))

(define (print-usage progname)
  (print "Usage: " progname " host port"))

(define (main)
  (let ((progname (pathname-file (car (argv)))))
    (match (command-line-arguments)
      ((host port)
       (launch-bot host (string->number port)))
      (_
       (print-usage progname)))))

(main)
.