(module vandusen 

($
 debug
 config
 call-with-connection
 start
 command
 message-handler
 plugin
 reply-to
 whisper-to
 say
 add-finalizer
 after-connect)

(import chicken scheme srfi-1 extras data-structures)
(use irc posix srfi-18)

(cond-expand
 (total-irregex
  (use irregex))
 (else
  (require-library regex)
  (import irregex)
  (define irregex-num-submatches irregex-submatches)))

(include "irc-helpers")

(define config (make-parameter '((nick . "vandusen"))))
(define config-file #f)

(define (load-config file)
  (load file)
  (set! config-file file))

(define (reload-config)
  (load config-file))

(let ((old config))
  (set! config
	(case-lambda
	 (() (old))
	 ((value) (old (append value (old)))))))

(define ($ setting . value)
  (if (null? value)
      (alist-ref setting (config))
      (config (alist-update! setting (car value) (config)))))

(define (debug message)
  (when ($ 'debug)
    (print "debug: " message)))

(define connection #f)
(define connection-mutex (make-mutex))

(define after-connect (make-parameter #f))
(define (run-after-connect)
  (and (after-connect) ((after-connect))))

(define (call-with-connection proc)
  (dynamic-wind
      (lambda ()
	(mutex-lock! connection-mutex))
      (cut proc connection)
      (lambda ()
	(mutex-unlock! connection-mutex))))

(define (start config-file)
  (load-config config-file)
  (set! connection (irc:connection server: ($ 'host) nick: ($ 'nick) user: (or ($ 'user) "nobody")  real-name: (or ($ 'real-name) "nobody") port: (or ($ 'port) 6667) password: ($ 'password) reconnect-timeout: (or ($ 'reconnect-timeout) 3600000)))
  (initialize)
  (print (format "connecting to ~A as ~A" ($ 'host) ($ 'nick)))
  (irc:connect connection)
  (run-after-connect)
  
  (call-with-connection 
      (lambda (c)
	(for-each (lambda (channel) 
		    (print (format "joining ~A" channel))
		    (irc:join c channel)) ($ 'channels))))
  
  (let loop ()
    (condition-case (irc:run-message-loop connection debug: ($ 'debug))
	(ex (i/o net) 
	    (irc:disconnect connection)
	    (print-error-message ex (current-error-port))
	    (print "reconnecting ...")
	    (irc:connect connection)
	    (loop)))))


(define commands '())

(define (command name . args)
  (set! commands (alist-update! name args commands)))

(define (message-handler . args)
  (apply irc:add-message-handler! (cons connection args)))

(define plugins '())

(define (plugin name thunk)
  (set! plugins (alist-update! name thunk plugins)))

(define (load-plugins)
  (for-each (lambda (plugin) 
	      (debug (format "loading plugin ~A" (car plugin)))
	      ((cdr plugin)))
	    plugins))

(define (reply-to message text #!key (method irc:say) (prefixed (eq? irc:say method)))
  (call-with-connection (cut irc:reply <> message text method prefixed)))

(define (say . args)
  (call-with-connection 
      (lambda (c)
        (apply irc:say (cons c args)))))

(define (whisper-to . args)
  (call-with-connection
      (lambda (c)
        (apply irc:whisper c args))))

(define (match-body matcher)
  (irregex `(: " :" (* whitespace) ,matcher (* whitespace) eos)))

(define (irregex-match-all-submatches m irregex)
  (if (zero? (irregex-num-submatches irregex))
      '()
      (map (cut irregex-match-substring m <>) 
	   (iota (irregex-num-submatches irregex) 1))))

(define (register-command matcher handler #!key public)
  (define (make-handler matcher)
    (let ((matcher (irregex matcher)))
      (lambda (m)
	(let ((matches (irregex-search matcher (irc:message-body m))))
	  (if (or public (member (car (irc:message-prefix m)) ($ 'operators)))
	      (thread-start! 
	       (lambda ()
		 (apply handler (cons m (irregex-match-all-submatches matches matcher)))))
	      (reply-to m "sorry, you are not allowed to do this"))))))

  (when ($ 'allow-query)
    (irc:add-message-handler! connection
                              (make-handler matcher)
                              receiver: ($ 'nick)
                              command: "PRIVMSG"
                              body: (match-body matcher)))

  (let ((matcher `(: ,($ 'nick) ":" (+ whitespace) ,matcher)))
    (irc:add-message-handler! connection (let ((handle (make-handler matcher)))
                                           (lambda (m)
                                             (and (eq? (string-ref (car (irc:message-parameters m)) 0) #\#)
                                                  (handle m))))
                              command: "PRIVMSG"
                              body: (match-body matcher))))


(define add-finalizer #f)
(define initialize #f)

(let ((finalizers '()))
  (set! add-finalizer
	(lambda (f)
	  (set! finalizers (cons f finalizers))))

  (set! initialize
	(lambda ()
	  (for-each (lambda (f) (f)) finalizers)

	  (let ((handlers (##sys#slot connection 11)))
	    (##sys#setslot connection 11 (filter (lambda (h) (and (pair? h) (eq? 'ping (car h)))) handlers)))

	  (register-command "reload"
			    (lambda (msg) 
			      (print "reloading")
			      (initialize)
			      (reply-to msg "reloaded" method: irc:action)))

	  (set! commands '())
	  (set! finalizers '())
	  (include "handlers")
	  (reload-config)
	  (load-plugins)

	  (for-each (lambda (command) 
		      (debug (conc "registering command " (car command)))
		      (apply register-command (cdr command))) commands))))

)