(in-package :kira)

(defclass location ()
  ((address :accessor address :initarg :address :initform nil)
   (latitude :accessor latitude :initarg :latitude :initform nil)
   (longitude :accessor longitude :initarg :longitude :initform nil)))

(define-canonical-uri (:map (address string))
  (:title "Map")
  (format nil "http://map.google.com/maps?q=~a" (uri-encode address)))

(define-canonical-uri (:map (location location))
  (:title "Map")
  (let ((address (address location))
	(latitude (latitude location))
	(longitude (longitude location)))
    (canonical-uri :map (or address (format nil "~a,~a" latitude longitude)))))

(defmethod address ((string string))
  string)

(defmethod princ-object ((location location) stream)
  (princ (address location) stream))

(defun google-maps-geocode (q)
  (multiple-value-bind (pathname content-type)
      (http-get (format nil "http://maps.google.com/maps/geo?key=~a&output=csv&q=~a" +google-maps-key+ (uri-encode q)))
    (when (and pathname (string= content-type "text/plain"))
      (multiple-value-prog1
	  (with-open-file (stream pathname)
	    (let* ((buf (make-string-output-stream))
		   (string (si:output-stream-string buf)))
	      (flet ((read-value ()
		       (loop initially (setf (fill-pointer string) 0)
			     for char = (read-char stream nil #\,)
			     until (char= char #\,)
			     do (write-char char buf)
			     finally (return (string-to-object string)))))
		(whereas ((code (read-value)))
		  (when (= code 200)
		    (whereas ((accuracy (read-value))
			      (latitude (read-value))
			      (longitude (read-value)))
		      (values latitude
			      longitude)))))))
	(delete-file pathname)))))

(defmethod geocode ((address string))
  (let ((key (nstring-downcase
	      (remove-extra-spaces
	       address
	       :predicate (lambda (char)
			    (or (char= char #\,)
				(whitespacep char)))))))
    (when (plusp (length key))
      (let* ((cons (get-value (geocode-cache *root*) key))
	     (latitude (car cons))
	     (longitude (cdr cons)))
	(if (and latitude longitude)
	    (values latitude longitude)
	    (multiple-value-bind (latitude longitude) (google-maps-geocode address)
	      (when latitude
		(with-transaction ()
		  (add-kv (geocode-cache *root*) key (cons latitude longitude))
		  (values latitude longitude)))))))))

(defmethod geocode ((location location))
  (let ((address (address location))
	(latitude (latitude location))
	(longitude (longitude location)))
    (if (and latitude longitude)
	(values latitude longitude)
	(setf (values (latitude location) (longitude location))
	      (geocode address)))))

(defmethod update-instance-from-query progn ((node geo-mixin))
  (setf-accessors-from-query node location))

(defun render-location (location &key inline)
  (whereas ((address (address location)))
    (html
     (render-markup address :anonymous-first-block-p t)
     (:if inline " " (:br))
     "(" (render-link :map location) ")")))

(defhandler (:geo)
  (:title "Geocode")
  (with-query (q)
    (when q
      (multiple-value-bind (latitude longitude) (geocode q)
	(html
	 ((:p :class "location")
	  (render-location q) (:br)
	  (:format "~a, ~a" latitude longitude)))))
    (html
     ((:standard-form :method :get)
      (text-field "q" q)
      (:p (submit-button))))))