add documentation searching feature (currently for cl)

anna.scm

@@ -6,6 +6,8 @@
              (ice-9 format)
              (ice-9 control)
              (ice-9 sandbox)
+             (ice-9 popen)
+             (ice-9 regex)
              (rnrs exceptions))
 
 (define +channels+ '("#tildetown" "#bots"))
@@ -77,24 +79,74 @@
   (format stream "PRIVMSG ~a :\x01ACTION ~a\x01\r\n" chn action))
 
 (define (input-filter str)
-  (define (remove-newline lst)
+  "Remove escaped chars to avoid fooling the bot into performing bad actions."
+  (define (remove-escaped-chars lst)
     (cond
      ((or (null? lst)
           (null? (cdr lst))) lst)
-     ((eq? (car lst) #\\) (remove-newline (cddr lst)))
+     ((eq? (car lst) #\\) (remove-escaped-chars (cddr lst)))
-     (else (cons (car lst) (remove-newline (cdr lst))))))
+     (else (cons (car lst) (remove-escaped-chars (cdr lst))))))
-  (list->string (remove-newline (string->list str))))
+  (list->string (remove-escaped-chars (string->list str))))
 
 (define (evaluate str)
+  "Evaluate the given string in a sandbox without crashing on errors."
   (guard (ex
           (else (begin (display "error encountered!\n")
                        'error))) ;; << this gets printed in chat
     (eval-in-sandbox (read (open-input-string str)))))
 
+(define (find-documentation language search)
+  "Find documentation for different programming languages."
+  (cond
+   ((null? language) "Missing langauge specifier.")
+   ((null? (string-tokenize search)) "Missing search string.")
+   ((eq? language 'cl) (find-cl-documentation search))
+   (else "Unrecognized language! Supported languages are: cl")))
+
+(define (slice start end lst)
+  "Return the list between index start and end (start inclusive, end not inclusive)."
+  (cond
+   ((> start end) (error "Start index can't be more than end index."))
+   ((> end (length lst)) (error "End index too large."))
+   ((= start end) '())
+   (else (cons (list-ref lst start)
+               (slice (+ 1 start) end lst)))))
+
+(define (escape-string str)
+  "Replace all special regex chars with escaped versions."
+  (define chars '(#\( #\) #\* #\+ #\?))
+  (define (member? elem lst)
+    (cond
+     ((null? lst) #f)
+     ((eq? (car lst) elem) #t)
+     (else (member? elem (cdr lst)))))
+  (define (loop lst)
+    (cond
+     ((null? lst) '())
+     ((member? (car lst) chars) (cons #\\ (cons (car lst) (loop (cdr lst)))))
+     (else (cons (car lst) (loop (cdr lst))))))
+  (list->string (loop (string->list str))))
+
+(define (find-cl-documentation search)
+  "Find documentation for Common Lisp."
+  (let ((status (system* "grep" (string-append "htm#" search "\"") "cl.htm")))
+    (cond
+     ((= 0 status)
+      (let* ((port (open-input-pipe (string-append "grep htm#" search "\\\" cl.htm")))
+             (out (string-match "Body.*\"" (read-line port)))
+             (sublink (list->string (slice (car (vector-ref out 1))
+                                           (- (cdr (vector-ref out 1)) 1)
+                                           (string->list (vector-ref out 0))))))
+        (close-pipe port)
+        (string-append "http://www.lispworks.com/documentation/lw70/CLHS/"
+                       sublink)))
+     (else "Symbol not found in documentation."))))
+
 (define (main-loop stream)
   (let* ((inl (read-line stream))
          (data (string-tokenize inl))
-         (chn (scar (scdr (member "PRIVMSG" data)))))
+         (chn (scar (scdr (member "PRIVMSG" data))))
+         (filtered-data (map input-filter data)))
     ;; debug print
     (format #t "~s~%" data)
     (cond
@@ -104,9 +156,12 @@
           (equal? ":!anna" (slist-ref data 3)))
       (send-message stream chn "Hello! I respond to !rollcall, !anna, and !eval <s-expr>."))
      ((equal? ":!eval" (slist-ref data 3))
-      (let* ((filtered-data (map input-filter data))
+      (let ((expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data))))))
-             (expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data))))))
         (send-message stream chn (evaluate expr))))
+     ((equal? ":!doc" (slist-ref data 3))
+      (let ((lang (slist-ref data 4))
+            (search (escape-string (string-concatenate (intersperse " " (cddr (member ":!doc" filtered-data)))))))
+        (send-message stream chn (find-documentation (string->symbol lang) search))))
      ((and (= 7 (length data))
            (equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
       (send-action stream chn "dies")