;;;-*- Mode: Lisp; Package: STRING-NET; Readtable: augmented-readtable -*-

(in-package :string-net)

(use-package :aserve)
(use-package :net.aserve)
(use-package :lxml)

(defmethod write-chunk ((dictionary xml-net-dictionary) start delta stream)
  (with-slots (xml-path) dictionary
    (with-open-file (xml-stream xml-path)
      (do-stream-chunk-lines (line xml-stream start (+ start delta))
	(write-line line stream)))))

#+test
(time (write-chunk *avar-dict* 2675508 6799 *standard-output*))

#+old
(defmethod write-word-entries ((dictionary xml-net-dictionary) word stream)
  (with-slots (xml-path index) dictionary
    (with-open-file (xml-stream xml-path)
      (let ((found-p nil))
	(map-string-values index word
			   (lambda (pair)
			     (print pair)
			     (setf found-p t)
			     (destructuring-bind (start delta)
				 (string-parse pair :whitespace ":")
			       (let* ((start (parse-integer start))
				      (end (+ start (- (parse-integer delta) 2))))
				 (do-stream-chunk-lines (line xml-stream start end)
				   (write-line line stream))))))
	#+ignore
	(unless found-p (write-chunk dictionary 258145 197 stream))))))

(defmethod write-word-entries ((dictionary xml-net-dictionary) word stream)
  (with-slots (xml-path index) dictionary
    (with-open-file (xml-stream xml-path)
      (let ((count 0))
	(nmap-string-suffixes
	 index word
	 (lambda (pair)
	   (destructuring-bind (&optional start delta)
	       (last (string-parse pair :whitespace ":") 2)
	     (when delta
	       (let* ((start (parse-integer start))
		      (end (+ start (- (parse-integer delta) 2))))
		 (print (list start delta))
		 (when (= (incf count) 5)
		   (return-from write-word-entries))
		 (do-stream-chunk-lines (line xml-stream start end)
		   (write-line line stream)))))))))))

;; 258145:199

(defmethod dictionary-entry-xml ((request http-request) entity)
  (with-xml-response (request entity stream (search dict)
			      :xsl #'dictionary-entry-xsl
			      :force-xslt :sablotron
			      )
    (print (list (loop for c across (utf-8-decode search) collect (char-code c)) dict))
    #m(?xml-stylesheet :type "text/xsl" :href "/dict.xsl")  
    #m((entries :search #L(substitute (code-char 1030) #\/ (print (utf-8-decode search)))
		:dict #L dict
		:title #L(cond ((string= dict "avar")
				"Saidov: Awarisch-russisches Wörterbuch")
			       ((string= dict "lak")
				"Xajdakov: Lakisch-russisches Wörterbuch")))
       #L(write-word-entries (cond ((string= dict "avar")
				    *avar-dict*)
				   ((string= dict "lak")
				    *lak-dict*))
			     search stream))))

#+ignore
(defmethod dictionary-entry-xsl ((request http-request) entity)
  (with-xml-response (request entity stream ())
    (dictionary-entry-xsl stream entity)))

(defstylesheet dictionary-entry-xsl ()
  ;;#m(!DOCTYPE "xsl:stylesheet []")
  #m((xsl:stylesheet xmlns:xsl "http://www.w3.org/1999/XSL/Transform" :version "1.0")
     ((xsl:template :match "/")
      (HTML
       (HEAD
	(TITLE (xsl:value-of/ :select "/entries/@title"))
	((style :type "text/css" :id "editStyle")
	 (!CDATA
	  (CSS-STYLE
	    (BODY :margin "3" :font-family "Tahoma, MS Sans Serif, Arial, Geneva, Helvetica")
	    (DIV :margin "10")
	    (DIV.html :margin "0")
	    (TD :vertical-align "top")
	    (span.orth :font-weight "bold")
	    (P :font-family "Times New Roman, Tahoma, MS Sans Serif, Arial, Geneva, Helvetica")))))
       (BODY
	((FORM :method "post"
	       :id "searchForm"
	       :action "/dict.xml")
	 (INPUT/ :type "hidden" :id "entry-id-input" :name "entry-id")
	 (H4 (xsl:value-of/ :select "/entries/@title"))
	 ((xsl:element :name "INPUT")
	  ((xsl:attribute :name "type") "text")
	  ((xsl:attribute :name "name") "search")
	  ((xsl:attribute :name "style") "width: 100%")
	  ((xsl:attribute :name "value")
	   (xsl:value-of/ :select "/entries/@search")))
	 ((xsl:element :name "INPUT")
	  ((xsl:attribute :name "type") "hidden")
	  ((xsl:attribute :name "name") "dict")
	  ((xsl:attribute :name "value")
	   (xsl:value-of/ :select "/entries/@dict"))))
	(xsl:apply-templates/ :select "/entries/entry"))))
	   
     ((xsl:template :match "entry")
      (p (xsl:apply-templates/)))
       
     ((xsl:template :match "orth")
      ((span :class "orth")
       (xsl:apply-templates/ :select "node()") (xsl:text " ")))

     ((xsl:template :match "class")
      (xsl:apply-templates/ :select "node()") (xsl:text " "))
       
     ((xsl:template :match "b")
      (b (xsl:apply-templates/ :select "node()")) (xsl:text " "))
       
     ((xsl:template :match "ib")
      (i (b (xsl:apply-templates/ :select "node()"))) (xsl:text " "))
       
     ((xsl:template :match "sfx")
      (b (xsl:apply-templates/ :select "node()")) (xsl:text " "))
       
     ((xsl:template :match "i")
      (i (xsl:apply-templates/ :select "node()")
	 (xsl:text " ")))
        
     ((xsl:template :match "itr")
      (i (xsl:apply-templates/ :select "node()")
	 (xsl:text " ")))
       
     ((xsl:template :match "num")
      (b (xsl:apply-templates/ :select "node()")
	 (xsl:text " ")))
       
     ((xsl:template :match "div")
      (b (xsl:apply-templates/ :select "node()")
	 (xsl:text " ")))
       
     ((xsl:template :match "tr")
      (span (xsl:apply-templates/ :select "node()")
	    (xsl:text " ")))))

(publish :path "/dict.xml"
	 :class 'xml/html-entity
	 :function #'dictionary-entry-xml
	 :documentation "experimental")

(publish :path "/dict.xsl"
	 :content-type "text/xml"
	 :function #'dictionary-entry-xsl
	 :documentation "experimental")

#+test
(ignore-errors (net.aserve::start :port 8008))


:eof