(module vandusen-doc ()

(import chicken scheme data-structures srfi-1)
(require-extension regex)
(import irregex)
(use vandusen chicken-doc uri-common srfi-18)

(verify-repository)

(define base-uri (uri-reference "http://api.call-cc.org/doc"))

(define (format-results results)
  (let* ((display-results (take results (min (length results) (or ($ 'doc-max-results) 5))))
	 (display-results (map (lambda (signature path)
				 (conc signature "  "
				       (uri->string (update-uri base-uri
								path: (append (uri-path base-uri)
									      (map symbol->string path))))))
			       (map node-signature display-results)
			       (map node-path display-results))))
    (conc (string-intersperse display-results "\n")
	  (if (< (length display-results) (length results))
	      (format "\n(showing the first ~A of ~A results)"
		      (length display-results)
		      (length results))
	      ""))))

(define (safe-call timeout thunk)
  (let ((mutex (make-mutex))
	(result (make-condition-variable)))
    (mutex-lock! mutex)
    (condition-case
     (let ((thread (thread-start! 
		    (lambda ()
		      (condition-variable-specific-set! result (thunk))
		      (condition-variable-signal! result)))))

       (if (mutex-unlock! mutex result timeout)
	   (condition-variable-specific result)
	   (begin
	     (thread-terminate! thread)
	     (error "operation timed out"))))
     (exn () exn))))

(define (search-command search)
  (lambda (message term)
    (let ((results (safe-call (or ($ 'doc-search-timeout) 3) (cut search term))))
      (reply-to message
		(cond ((condition? results)
		       (format "error: ~A" (get-condition-property results 'exn 'message)))
		      ((null? results)
		       (format "sorry, I couldn't find docs matching ~S" term))
		      (else (format-results results)))
		prefixed: #f))))

(plugin 'doc
	(lambda ()
	  (command 'doc
		   '(: "doc" (+ space) (submatch (+ any)))
		   (search-command match-nodes)
		   public: #t)

	  (command 'wtf
		   '(: "wtf" (+ space) (submatch (+ any)))
		   (search-command (lambda (term) (match-nodes (irregex term))))
		   public: #t))))