;;;
;;; A web-based dictionary, by William Bland.  www.abstractnonsense.com
;;;

(in-package :dict)

(defvar dictionary (make-hash-table :test #'equal)
  "A mapping from crunches of words, to lists of definitions")

(defun word-and-definition (entry)
  "Get a word and its definition from a line in a dictionary file"
  (let ((middle (position #\( entry)))
    (values (subseq entry 0 (1- middle))
            (subseq entry middle))))

(defun crunch (string)
  "\"Crunch\" a string - throw away things like vowels and repeated letters"
  (let ((crunched nil)
        (last-char nil))
    (loop for char across string do
         (cond ((and (equalp last-char #\p) (equalp char #\h)) ; ph => f
                (pop crunched)
                (push #\f crunched))
               ((and (equalp last-char #\i) (equalp char #\e)) ; ie => y
                (push #\y crunched))
               ((equalp char #\z) ; z => s
                (push #\s crunched))
               ((and (member char '(#\b #\c #\d #\f #\g #\h #\j #\k #\l #\m #\n
                                    #\p #\q #\r #\s #\t #\v #\w #\x #\y #\z))
                     (not (eql char last-char)))
                (push char crunched)))
         (setf last-char char))
    (coerce (nreverse crunched) 'string)))

(defun add-to-dictionary (word definition)
  "Add a word and its definition to the dictionary"
  (setf (gethash (crunch word) dictionary)
        (nreverse (gethash (crunch word) dictionary)))
  (push (list word definition) (gethash (crunch word) dictionary))
  (setf (gethash (crunch word) dictionary)
        (nreverse (gethash (crunch word) dictionary))))

(defun load-dictionary (file)
  "Load a dictionary file and add all entries to the dictionary"
  (with-open-file (in file :direction :input :external-format :ANSI_X3.4-1968)
    (let ((line nil))
      (loop while (setf line (read-line in nil nil)) do
           (when (> (length line) 3)
             (multiple-value-call #'add-to-dictionary
               (word-and-definition (string-downcase line))))))))

(defun string-distance (s1 s2)
  "The distance between two strings"
  (let ((d 0))
    (loop
       for c1 across s1
       for c2 across s2 do
         (setf d (+ (* d 26) (abs (- (char-code c1) (char-code c2))))))
    (dotimes (i (abs (- (length s1) (length s2))) d)
      (setf d (+ (* d 26) 26)))))

(defun find-definitions (word)
  "List the definitions of WORD, including possible mis-spellings, sorted
by how close the spellings are to WORD"
  (format t ";; Finding definitions of ~A~%" word)
  (force-output)
  (sort (copy-tree (gethash (crunch word) dictionary)) #'<
        :key (lambda (result) (string-distance (first result) word))))

;;;;
;;;; The web interface
;;;;

(defun parse-form-slots (s)
  "Parse slots from a url-part of the form name1=value1&name2=value2..."
  (if (or (null s) (equal s ""))
      nil
      (let* ((index0 (if (char= (aref s 0) #\?) 1 0))
             (index1 (position #\= s))
             (index2 (position #\& s)))
        (if index1
            (cons (list (subseq s index0 index1)
                        (urlstring-unescape (subseq s (1+ index1) index2)))
                  (and index2
                       (parse-form-slots (subseq s (1+ index2)))))
            nil))))

(defun my-fqdn ()
  (sb-bsd-sockets:host-ent-name
   (sb-bsd-sockets:get-host-by-name (machine-instance))))

(defvar *demo-url*
  (make-url :scheme "http" :host "abstractnonsense.com" :port 8001))

(defvar *listener*
  (make-instance 'serve-event-http-listener
                 :port (url-port *demo-url*)))

(defclass spell-handler (handler)
  ())

(defun print-results (results stream)
  "Print a list of words and definitions, as an html table"
  (format stream "<table>")
  (let ((last nil))
    (dolist (result results)
      (unless (equal last (first result))
        (when last
          (format stream "</table></tr>~%"))
        (format stream "<tr><td class=word valign=top>~:(~A~)</td><td><table>"
                (first result)))
      (format stream "<tr><td>~A</td></tr>~%"
              (second result))
      (setf last (first result)))
    (when last
      (format stream "</table></tr>~%")))
  (format stream "</table>~%"))

(defun print-results-to-string (results)
  "Print a list of words and definitions, as an html table, to a string"
  (with-output-to-string (out)
    (print-results results out)))

(defvar *form*
  '((form :method "get")
    (p ((input :name "word" :type "text"
               :size "30" :value "")) " "
     ((input :name "Find" :value "Find"
             :type "submit")))))

(defvar *footer*
  '(p "By "
    ((a :href "http://www.abstractnonsense.com/")
     "William Bland")))

(defvar *stylesheet*
  "<link rel=stylesheet href=\"style.css\" type=\"text/css\">")

(defmethod handle-request-response ((handler spell-handler)
                                    (method (eql :get)) request)
  (let* ((url (request-unhandled-part request))
         (is-front (equal url ""))
         (params (parse-form-slots url))
         (word (string-downcase (second (assoc "word" params
                                               :test #'equalp)))))
      (request-send-headers request)
      (html-stream
       (request-stream request)
       (if is-front
           `(html (head (title "Dictionary")
                        ,*stylesheet*)
                  (body (h1 "Dictionary")
                        ,*form*
                        ,*footer*))
           `(html (head (title "Results for " ,word)
                        ,*stylesheet*)
                  (body ((table :width "100%")
                         (tr (td (h1 "Results for " ,word))
                             ((td :align "right")
                              ,*form*)))
                        (p ,(print-results-to-string (find-definitions word)))
                        ,*footer*))))))

(defun start-web ()
  "Start the web interface"
  (install-handler (http-listener-handler *listener*)
                   (make-instance 'spell-handler)
                   (urlstring (merge-url *demo-url* "/spell"))
                   nil)
  (install-handler (http-listener-handler *listener*)
                   (make-instance 'static-file-handler :pathname ".")
                   (urlstring *demo-url*) nil)
  (start-listening *listener*))

(defun stop-web ()
  "Shut down the web interface"
  (stop-listening *listener*))