(in-package :lojban-dot)

(require 'cl-xmpp)
; setup up the connection to jabber server

(defvar *jabber-connection*)


(defun setup-jabber-connection ()
    (setf *jabber-connection* (cl-xmpp:connect :hostname "jabber.dk"))
    (cl-xmpp:auth *jabber-connection* "jbominji" "jbojbo" "jbominji" :mechanism :sasl-plain :bind-et-al t :send-presence t)
)

(defun show-parsed-text (pr)
  (let ((input (cl-peg:pr-original-input pr))
	(start (first (cl-peg:matched-region pr)))
	(end (first (rest (cl-peg:matched-region pr)))))
    (subseq input start end)))

(defun build-gloss (pr)
;  (break)
  (let ((tree (lojban::filter-and-convert-parse-tree pr)))
;    (format t "~a" tree)
    ;(list 
     (walk-pv-tree tree pr nil);)
))

; gismu lookup

(defvar *gismu-file* "/usr/share/lojban/gismu.txt")
(defvar *cmavo-file* "/usr/share/lojban/cmavo.txt")
(defvar *gismu-map* nil)
(defvar *cmavo-map* nil)
(defun initialize-gismu ()
  (if (null *gismu-map*)
      (progn
	(setf *gismu-map* (make-hash-table))
	(with-open-file (file *gismu-file* :direction :input)
	  (do ((line (read-line file) (read-line file nil nil)))
	      ((null line))
	    (let ((gismu (subseq line 1 6))
		  (rafsi1 (subseq line 7 11))
		  (rafsi2 (subseq line 11 15))
		  (rafsi3 (subseq line 15 19))
		  (gloss (subseq line 20 37)))
;	      (format t "~a ~s ~s ~s~%" gismu rafsi1 rafsi2 rafsi3)
	      (setf (gethash (intern (string-downcase gismu)) *gismu-map*) (list gismu rafsi1 rafsi2 rafsi3 gloss))
	      ))))))

(defun initialize-cmavo ()
  (if (null *cmavo-map*)
      (progn
	(setf *cmavo-map* (make-hash-table))
	(with-open-file (file *cmavo-file* :direction :input)
	  (do ((line (read-line file) (read-line file nil nil)))
	      ((null line))
	    (let ((cmavo (subseq line 1 10))
		  (class (subseq line 11 19))
		  (gloss (subseq line 20 61)))
;		  (descrip (subseq line 62 167))
;	      (format t "~s ~s ~s~%" cmavo class gloss)
	      (setf (gethash (intern (string-trim " " (string-downcase cmavo))) *cmavo-map*) (list cmavo class gloss))
	      ))))))


(defun lookup-gismu (gismu)
  (initialize-gismu)
  (let ((lookup (gethash (intern (string-downcase gismu)) *gismu-map*)))
    (if (null lookup)
	(concatenate 'string "<<GISMU NOT FOUND>>! " gismu)
	(nth 4 lookup))))

; cmavo lookup
(defun lookup-cmavo (cmavo)
  (initialize-cmavo)
  (let ((lookup (gethash (intern (string-trim " " (string-downcase cmavo))) *cmavo-map*)))
    (if (null lookup)
	(concatenate 'string "<<CMAVO NOT FOUND>>! " cmavo)
	(nth 2 lookup))))


; walking the parse tree
(defgeneric walk-pv-tree (tree pr output))

(defmethod walk-pv-tree ((tree lojban::|gismu|) pr output)
  (let* ((input (slot-value tree 'lojban:text))
	 (gloss (format nil ".i zo ~a cu gismu la'e zoi gy. ~a gy.~%" input (string-trim " " (lookup-gismu input)))))
;    (concatenate 'string gloss output)
    (append (list gloss) output)
  ))

(defmethod walk-pv-tree ((cmavo lojban:cmavo-group) pr output)
  (let* ((input (slot-value cmavo 'lojban:text))
	 (gloss (format nil ".i zo ~a cu cmavo la'e zoi gy. ~a gy.~%" input (string-trim " " (lookup-cmavo input)))))
 ;   (concatenate 'string gloss output)
   (append (list gloss) output)
  ))

(defmethod walk-pv-tree ((l list) pr output)
  (cond ((null l) nil)
	(t (append (list (walk-pv-tree (first l) pr nil)) (walk-pv-tree (rest l) pr nil) output))
))

(defmethod walk-pv-tree ((tree lojban:jbovalsi) pr output)
  (walk-pv-tree (slot-value tree 'lojban:children) pr output)
  )

; handle a message from client

(defmethod cl-xmpp:handle ((connection cl-xmpp:connection) (message cl-xmpp:message))
  (let ((body (slot-value message 'cl-xmpp:body)))
    (progn
      (format t "~% Received body: ~a" body)
      (initialize-parser)
      (let* ((*pr* (cl-peg:pp lojban-dot::*lg* body t))
	     (matched (cl-peg:pr-matched *pr*)))
	(if matched
	    (cl-xmpp:message connection (cl-xmpp:from message)  
			     (format nil "input: ~a~% ~a" (show-parsed-text *pr*) (build-gloss *pr*)))
	    (cl-xmpp:message connection (cl-xmpp:from message)  
			     (format nil "lojban match failed"))
	    )
	))))
	  
(defun test (text)
  (initialize-parser)
  (let* ((*pr* (cl-peg:pp lojban-dot::*lg* text t))
	 (matched (cl-peg:pr-matched *pr*)))
    (if matched
	(format t "input: ~a~%~a" (show-parsed-text *pr*) (build-gloss *pr*))
	(format t "parse failed~%")
)))

;; (defmethod cl-xmpp:handle ((connection cl-xmpp:connection) nubble)
;;   (format t "handle ~%")
;;   (call-next-method connection nubble))


;; (defmethod cl-xmpp:elements (foo)
;;   (format t "elements~%"))

;; FROM JBOMINJI



; --------------------------------------------------------------------------------
; JABBER
; --------------------------------------------------------------------------------


;; (defvar *jabber-connection*)


;; (defun setup-jabber-connection ()
;;     (setf *jabber-connection* (cl-xmpp:connect :hostname "jabber.dk"))
;;     (cl-xmpp:auth *jabber-connection* "jbominji" "jbojbo" "jbominji" :mechanism :sasl-plain :bind-et-al t :send-presence t)
;; )


;; ; handle a message from client

;; (defmethod cl-xmpp:handle ((connection cl-xmpp:connection) (message cl-xmpp:message))
;;   (sb-thread:with-mutex ((lojban-parser:get-mutex))
;;     (let ((body (slot-value message 'cl-xmpp:body)))
;;       (progn
;; 	(format t "~% Received body: ~a" body)
;; 	(initialize-parser)
;; 	(let* ((*pr* (cl-peg:pp lojban-parser::*lojban-grammar* body t))
;; 	       (matched (cl-peg:pr-matched *pr*)))
;; 	  (if matched
;; 	      (cl-xmpp:message connection (cl-xmpp:from message)  
;; 			       (format nil "input: ~a~% ~a" (show-parsed-text *pr*) (build-gloss *pr*)))
;; 	      (cl-xmpp:message connection (cl-xmpp:from message)  
;; 			       (format nil "lojban match failed"))
;; 	      )
;; 	  )))))