irc-bot.lisp

(ql:quickload 'cl-irc)

;; TODO: module system
;;(load "./reference-module.lisp")
;;(load "./knowledge-module.lisp")
;;(load "./procedure-module.lisp")

(defvar *connection* nil "IRC connection")
(defvar *nickname* "bot" "Default name of the bot.")

(defmacro aif (test consequence &optional (else nil))
  "An anaphoric conditional statement."
  `(let ((it ,test))
     (if it ,consequence
         (symbol-macrolet ((it ,test))
           ,else))))

;; TODO: document function
(defun tokens (string test start)
  "docstring"
  (let ((p1 (position-if test string :start start)))
    (if p1
        (let ((p2 (position-if #'(lambda (c) (not (funcall test c))) string :start p1)))
          (cons (subseq string p1 p2) (if p2 (tokens string test p2) nil)))
        nil)))

(defun string-exclude (character)
  "Return nil if the argument is a character which should not appear in the final string."
  (or (eq #\SPACE character) (eq #\" character) (eq #\, character)))

(defun string-tokenize (string)
  "Return a list of tokens, i.e. #\Space separated elements, from given string.

Notice that encountered strings are included without double-quotes."
  (let ((exclude (lambda (character) (not (string-exclude character)))))
    (tokens string exclude 0)))

(defun list-to-string (list)
  "Concatenate a list of strings together, putting spaces between elements."
  (format nil "~{~A~^ ~}" list))

;; TODO: document function
(defun valid-message (string prefix &key space-allowed)
  "docstring"
  (if (eql (search prefix string :test #'char-equal) 0)
      (and (or space-allowed (not (find #\Space string :start (length prefix)))) (length prefix))
      nil))

;; TODO: document macro
;; (defmacro alternative-forms (address)
;;   "docstring"
;;   `(list (format nil "~A " ,address)
;;       (format nil "~A: " ,address)
;;       (format nil "~A:" ,address)
;;       (format nil "~A, " ,address)))

;; TODO: need to generalise the address input
(defun strip-address (string &key (address *nickname*) (final nil))
  "Strip ADDRESS from STRING."
  (loop for i in (list (format nil "~A " address)
                       (format nil "~A: " address)
                       (format nil "~A:" address)
                       (format nil "~A, " address))
        do (aif (valid-message string i :space-allowed t)
               (return-from strip-address (subseq string it))))
  (and (not final) string))

(defun shuffle-hooks ()
  "Replace `irc-privmsg-message' with `message-hook'."
  (irc::remove-hooks *connection* 'irc::irc-privmsg-message)
  (irc::add-hook *connection* 'irc::irc-privmsg-message 'message-hook))

(defun start-bot (nickname server &rest channels)
  "Start the IRC bot passing in a NICKNAME, a server, and an optional list of CHANNELS to join."
  (setf *nickname* nickname)
  (setf *connection* (irc::connect :nickname *nickname* :server server))
  (mapcar #'(lambda (channel) (irc::join *connection* channel)) channels)
  (irc::add-hook *connection* 'irc::irc-privmsg-message 'message-hook)
  (irc::read-message-loop *connection*))

;; TODO: (defun private-message (destination string &optional args) (irc::privmsg *connection* destination `(format nil ,string ,@args)))
(defun private-message (destination string)
  "Simplifies calls to `irc:privmsg'."
  (irc::privmsg *connection* destination string))

(defun process-list (list)
  "Provides an interface to process message input."
  ;; TODO: module hooks (i.e. `reference-hook', `knowledge-hook', and `procedure-hook')
  ;; TODO: spawn off a new thread for processing
  (format nil "Sorry, I don't understand ~A" (list-to-string list)))

(defun message-hook (message)
  "The main message hook. When an IRC message is received, it is processed here."
  (let ((destination (if (string-equal (first (irc::arguments message)) *nickname*)
                         (irc::source message)
                         (first (irc::arguments message))))
        (to-lookup (string-tokenize (strip-address (first (last (irc::arguments message)))))))
    ;; DEBUG:
    ;;(private-message destination (format nil "s: ~A; a: ~A; t: ~a"
    ;;                                     (irc::source message)
    ;;                                     (irc::arguments message)
    ;;                                     to-lookup))
    ;; NOTE: if message is directed to the bot ...
    ;; FIX: this hard-codes a colon as the nick/message separator
    ;;      ... while the function `strip-address' accommodates alternatives
    (when (string-equal (format nil "~A:" *nickname*)
                        (first (string-tokenize (car (last (irc::arguments message))))))
      (private-message destination (format nil "~A: ~A" (irc::source message) (process-list to-lookup))))))