(defpackage :cl-bloglines
  (:use :cl :it.bese.ucw :it.bese.ucw-user))

(in-package :cl-bloglines)

(require 'xmls)
(require 'aserve)

(setf ucw::*debug-on-error* t)

(defparameter *rpc-url* "http://rpc.bloglines.com/")

(defun do-bloglines-request (username password &key (feed nil) (update 0))
  "Does a listsubs, or a getitems if FEED is non-nil.
   Set UPDATE to 1 to mark a feed read"
  (let ((args `(:basic-authorization ,(cons username password)))
	(url (concatenate 'string *rpc-url* (if feed "getitems"	"listsubs"))))
    (when feed (setf args (append `(:query (("s" . ,feed) ("n" . ,update))) args)))
    (apply #'net.aserve.client:do-http-request
	   url args)))

;;;some xmls utilities functions
(defun assoc-value (key alist)
  (cadr (assoc key alist :test #'equalp)))

(defun get-by-name (name node)
  (let ((n (find-if #'(lambda (x) (equalp (car x) name))
		    (xmls:node-children node))))
    (if (atom (third n))
	(values (third n) (second n))
	n)))

(defun get-all-by-name (name node)
  (remove nil (mapcar #'(lambda (x)
			  (when (equalp (car x) name) x))
		      (xmls:node-children node))))

(defapplication cl-bloglines
  (:url-prefix "/bl/"))

;;;; define the window component

(defclass bl-window (simple-window-component)
  ((body :initarg :body
         :accessor body
         :component bl-login))
  (:default-initargs
      :title "CL-Bloglines"
    :stylesheet "stylesheet.css")
  (:metaclass standard-component-class))

(defentry-point "index.ucw" (:application cl-bloglines) ()
  (call 'bl-window))

(defmethod render-on ((res response) (win bl-window))
  (<:h1 (<:as-html "CL-Bloglines RSS Reader"))
  (render-on res (body win)))

;;; a base class for all UI objects.
(defclass bl-class ()
  ((feeds :accessor feeds
	  :initarg :feeds :initform "")
   (items :accessor items
	  :initarg :items :initform nil)
   (current-feed :accessor current-feed
		 :initarg :current-feed :initform nil)
   (current-item :accessor current-item
		 :initarg :current-item :initform nil)
   (auth :accessor auth :initarg :auth :initform nil))
  (:metaclass standard-component-class))

(defmethod get-feeds ((bl bl-class))
  "Returns the XML text in outline format and sets (feeds self). nil on errors"
  (multiple-value-bind (feeds result)
      (do-bloglines-request (car (auth bl)) (cdr (auth bl)))
    (when (equal 200 result) (setf (feeds bl) feeds))))

(defmethod get-items ((bl bl-class))
  "Returns the RSS XML for the current feed"
  (multiple-value-bind (items result)
	(do-bloglines-request (car (auth bl)) (cdr (auth bl))
			      :feed (current-feed bl))
  (if (equal 200 result)
      (setf (items bl) items)
      (setf (items bl) nil))))

(defmethod extract-feeds ((bl bl-class))
  "Extracts the feed outine from the xml. returns an xmls node"
  (cddr (third (fourth (xmls:parse (feeds bl))))))

(defmethod extract-items ((bl bl-class))
  "extracts the rss items from the XML. Returns an xmls node"
  (caddr (xmls:parse (items bl))))

(defaction select-item ((bl bl-class) item)
  "Makes item the current item"
  (setf (current-item bl) item))

(defaction select-feed ((bl bl-class) feed)
  "Makes feed the current feed"
  (setf (current-feed bl) feed))

(defclass bl-login (login bl-class)
  ()
  (:metaclass standard-component-class)
   (:documentation "Gets the username and password and retrieves the feed"))

(defmethod check-credentials ((login bl-login))
  (setf (auth login)
	(cons (login.username login)
	      (login.password login)))
  (get-feeds login))

;;;this has to be ini the ucw package. possibly a bug in ucw.
(defaction it.bese.ucw::login-successful ((login bl-login))
  (call 'rss-reader
	:feeds (feeds login)
	:auth (auth login)))

(defclass feeds-pane (widget-component bl-class)
  ((feeds-outline :accessor feeds-outline))
  (:metaclass standard-component-class)
  (:documentation "a UI class to hold the list of feeds"))

(defmethod render-on ((res response) (f feeds-pane))
  (<:h3 (<:as-html "Subscriptions"))
  (dolist (x (feeds-outline f))
    (let ((id (assoc-value "BloglinesSubId" (second x)))
	  (title (assoc-value "title" (second x)))
	  (unread (assoc-value "BloglinesUnread" (second x))))
      (<:div (<ucw:a :action (select-feed f id)
		     (if (equalp "0" unread)
			 (<:as-html title)
			 (<:as-html
			  (format nil "~A (~A)" title unread))))))))

(defclass items-pane (widget-component bl-class)
  ()
  (:metaclass standard-component-class)
  (:documentation "A UI pane to hold the Titles of the RSS feed"))

(defmethod render-on ((res response) (ip items-pane))
  (<:h3 (<:a :href (get-by-name "link" (items ip))
	     (<:as-html (get-by-name "title" (items ip)))))
  (dolist (item (get-all-by-name "item" (items ip)))
    (<:div :class "item" (<ucw:a :action (select-item ip item)
	    (<:as-html (get-by-name "title" item))))))

(defclass body-pane (widget-component bl-class)
  ()
  (:metaclass standard-component-class)
  (:documentation "a UI pane to hold the bdy of the blog post"))

(defmethod render-on ((res response) (b body-pane))
  (<:h3 (<:as-html (get-by-name "title" (current-item b))))
  (<:a :href (get-by-name "link" (current-item b))
       (<:as-html "(link)"))
  (<:div :class "content"
	 (<:as-is (get-by-name "description" (current-item b)))))

(defclass rss-reader (widget-component bl-class)
  ((feeds-pane :accessor feeds-pane :component feeds-pane)
   (items-pane :accessor items-pane :component items-pane)
   (body-pane :accessor body-pane :component body-pane))
  (:metaclass standard-component-class)
  (:documentation "the RSS reader application itself"))

(defmethod render-on :before ((res response) (rss rss-reader))
  "Propogates the state of the current-feed/item throughout the application
Also gets the current RSS Feed if needed"
  (with-slots (current-feed current-item feeds-pane
			    items-pane body-pane) rss
					;set the current-feed/item
    (setf current-feed (current-feed feeds-pane)
	  current-item (current-item items-pane))
    (setf  (current-item body-pane) current-item)
					;update if current-feed has changed.
    (when (not (equal current-feed (current-feed items-pane)))
      (get-items rss)
      (setf (current-feed items-pane) current-feed
	    (items items-pane) (extract-items rss)))))
    
(defmethod shared-initialize :after ((rss rss-reader) foo &rest bar)
  "Sets up the initial feed pane"
  (declare (ignore foo bar))
  (setf (feeds-outline (feeds-pane rss))
	(extract-feeds rss)))

(defmethod render-on ((res response) (rss rss-reader))
  (<:table :width "100%" :style "{border:1px solid black}"
   (<:tr (<:td :rowspan 2 :valign "top" :width "20%" :style "{border-right : 1px solid black}"
	       (render-on res (feeds-pane rss)))
	 (<:td (render-on res (items-pane rss))))
   (<:tr (<:td (<:hr)(render-on res (body-pane rss))))))