(declaim (optimize (debug 3) (safety 3) (speed 0)))
(in-package :alimenta.atom)

(defclass atom-category ()
  ((term :initarg :term :initform nil :accessor term)
   (label :initarg :label :initform nil :accessor label)
   (scheme :initarg :scheme :initform nil :accessor scheme)))
(defmethod print-object ((o atom-category) s)
  (format s "#.(~s ~s ~s ~s)" 'make-category (term o) (label o) (scheme o)))

(defclass atom-person ()
  ((name  :initarg :name  :type (or null string) :initform nil :accessor name)
   (uri   :initarg :uri   :type (or null string) :initform nil :accessor uri )
   (email :initarg :email :type (or null string) :initform nil :accessor email)))

(defclass atom-feed (alimenta:feed)
  ((subtitle   :initarg :subtitle                        :initform nil :accessor subtitle)
   (id         :initarg :id                              :initform nil :accessor id)
   (links      :initarg :links                           :initform nil :accessor links)
   (icon       :initarg :icon                            :initform nil :accessor icon)
   (categories :initarg :categories :type (or null list) :initform nil :accessor categories)
   (logo       :initarg :logo                            :initform nil :accessor logo)
   (updated    :initarg :updated                         :initform nil :accessor updated)
   (authors    :initarg :authors    :type (or null list) :initform nil :accessor authors)))

(defclass alimenta::link ()
  ((alimenta::relation :initarg :rel)
   (alimenta::target   :initarg :target)))

(defclass atom-item (alimenta:item)
  ((author-uri :initarg :author-uri :initform nil :accessor author-uri)
   (categories :initarg :categories :type (or null list) :initform nil :accessor categories)))

(defun make-category (term &optional label scheme)
  (make-instance 'atom-category :term term :label label :scheme scheme))

(defun make-person (name &optional uri email)
  (make-instance 'atom-person :name name :uri uri :email email))

(defmethod alimenta::get-items (xml-dom (feed-type (eql :atom)))
  ($ (inline xml-dom) "feed > entry"))

(defun get-link (xml)
  "This only handles alternate links"
  (let ((links ($ (inline xml) "> link[rel=alternate]" (combine (attr :type) (attr :href)))))
    (map 'list
         (lambda (x)
           (destructuring-bind (type href) x
             (setf (alimenta::link (make-keyword (string-upcase type)))
                   (cons type href))))
         links)))

(defmethod make-item (xml-dom (type (eql :atom)))
  (let* ((lquery:*lquery-master-document* xml-dom)
         (item-title ($ "> title" (text) (node)))
         (links ($ "> link" (combine (attr "rel") (attr "href"))))
         (sel-links (cadr (find-if (lambda (x) (aif (car x) (equal it "alternate") t))
                                   links)))
         (item-link (or sel-links (cdr (when (> (length links) 0) (elt links 0)))))
         (item-date (or ($ "> updated" (text) (node))
                        ($ "> published" (text) (node)))) ;; Which should be default?
         (item-guid ($ "> id" (text) (node)))
         (item-description ($ "> summary" (text) (node)))
         (item-content ($ "> content" (text) (node)))
         (item-author ($ "> author > name" (text) (node)))
         (item-author-uri ($ "> author > uri" (text) (node)))
         (item-categories ($ (inline xml-dom) "> category"
                            (combine (attr "term") (attr "label") (attr "scheme"))
                            (map-apply #'make-category)))
         (*tag-dispatchers* *html-tags*)
         (content (with-output-to-string (s)
                    (awhen (or item-content item-description) (serialize  (parse it) s)))))
    (make-instance 'atom-item
                   :doc xml-dom
                   :content content
                   :date (local-time:parse-timestring item-date)
                   :description item-description
                   :id item-guid
                   :author item-author
                   :author-uri item-author-uri
                   :link item-link
                   :categories (coerce item-categories 'list)
                   :title item-title)))

(defun get-authors (xml-dom)
  (let ((authors ($ (inline xml-dom) "feed > author")))
    (loop for author across authors
          collect (make-person
                    ($ (inline author) "> name" (text) (node))
                    ($ (inline author) "> uri" (text) (node))
                    ($ (inline author) "> email" (text) (node))))))

(defmethod alimenta::-to-feed (xml-dom (type (eql :atom)) &key feed-link)
  (declare (ignore type))
  (flet ((get-feed-elem (selector) ($ (inline xml-dom) selector (text) (node)))
         (get-feed-elem-attr (selector attr) ($ (inline xml-dom) selector (attr attr) (node))))
    (let ((doc-title (get-feed-elem "feed > title"))
          (doc-subtitle (get-feed-elem "feed > subtitle"))
          (doc-summary (get-feed-elem "feed > summary"))
          (doc-icon (get-feed-elem "feed > icon"))
          (doc-logo (get-feed-elem "feed > logo"))
          (doc-id (get-feed-elem "feed > id"))
          (doc-updated (awhen (get-feed-elem "feed > updated")
                         (local-time:parse-timestring it)))
          (doc-link (or (get-feed-elem-attr "feed > link[rel=alternate]" "href")
                        (get-feed-elem-attr "feed > link:not([rel=self])" "href")
                        (get-feed-elem-attr "feed > link[rel=self]" "href")
                        feed-link))

          (doc-links (coerce ($ (inline xml-dom)
                               "feed > link"
                               (combine (attr "rel")
                                        (attr "href")))
                             'list))
          (doc-feed-link (or feed-link
                             (get-feed-elem-attr "feed > link[rel=self]" "href")))
          (doc-categories ($ (inline xml-dom) "feed > category"
                            (combine (attr "term") (attr "label") (attr "scheme"))
                            (map-apply #'make-category)))
          (doc-authors (get-authors xml-dom)))
      (make-instance 'atom-feed
                     :title doc-title
                     :description doc-summary
                     :icon doc-icon
                     :logo doc-logo
                     :link doc-link
                     :links doc-links
                     :updated doc-updated
                     :id doc-id
                     :feed-link doc-feed-link
                     :subtitle doc-subtitle
                     :categories (coerce doc-categories 'list)
                     :authors doc-authors
                     ))))
;}}}

(defmacro defconstants (&body constants)
  (list*
    'progn
    (loop for (name value &optional doc) in constants
        collect `(defconstant ,name ,value ,@(when doc (list doc))))))

(defvar *defconstants-really-verbose* nil)
#+sbcl (defmacro defconstants-really (&body constants)
  "auto-invoke the continue restart . . ."
  `(handler-bind ((sb-ext:defconstant-uneql
                    (lambda (c)
                      (when *defconstants-really-verbose*
                        (format t "~&Changing definition of ~s from ~s to ~s~%"
                                (sb-ext:defconstant-uneql-name c)
                                (sb-ext:defconstant-uneql-old-value c)
                                (sb-ext:defconstant-uneql-new-value c)))
                      (continue c))))
     (defconstants ,@constants)))

#-sbcl (defmacro defconstants-really (&body constants)
	 `(defconstants ,@constants))

(defmethod generate-xml ((feed feed) (feed-type (eql :atom)) &key partial)
  (let ((feed-root (or ($1 (inline partial) "feed")
                    (plump:make-element (plump:make-root) "feed"))))
    (prog1 feed-root
      (with-accessors ((title title) (id id) (updated updated) (link link)
                       (feed-link feed-link) (description description)) feed
        ($ (inline (make-element feed-root "title")) (text title)

           (inline (make-element feed-root "link"))
           (attr "href" feed-link) (attr "rel" "self")

           (inline (make-element feed-root "link"))
           (attr "href" link) (attr "rel" "alternate") (attr "type" "text/html")

           (inline (make-element feed-root "id")) (text id) (node)
           (inline (make-element feed-root "summary")) (text description) (node)
           (inline (make-element feed-root "updated")) (text updated) (node)
           )))))


(defmethod generate-xml ((item item) (feed-type (eql :atom)) &key partial)
  (let ((parent (if (string-equal (tag-name partial) "feed")
                  partial
                  (plump:make-element (plump:make-root) "feed"))))
    (prog1 parent
      (let ((item-root (make-element parent "entry")))
        (with-accessors ((title title) (id id) (date date) (link link)
                         (content content) (author author) (author-uri author-uri)) item
          ($ (inline (make-element item-root "title")) (text title)
             (inline (make-element item-root "link")) (attr "href" link)
             (inline (make-element item-root "id")) (text id) (node)
             (inline (make-element item-root "pubDate")) (text date)
             (inline (make-element item-root "author"))
             (append ($ (inline (make-element item-root "name")) (text author)))
             (append ($ (inline (make-element item-root "uri"))  (text author-uri)))
             (inline (make-element item-root "content")) (text content)
             (inline (make-element item-root "updated")) (text date) (node)
             ))))))


(defconstants-really
  (+title+ "The Title")
  (+author+ "Joe Q Public")
  (+author-uri+ "http://example.com/joeq")
  (+content+ "Teh Content")
  (+id+ "t3_43tjwv")
  (+link+ "http://example.com/something")
  (+published+ "2016-02-02T09:41:27+00:00")

  (+entry1+
    (format nil
            "<entry>
             <author>
             <name>~A</name>
             <uri>~A</uri>
             </author>
             <category term='programming' label='/r/programming'/>
             <content type='html'>~A</content>
             <id>~a</id>
             <link href='~a'/>
             <published>~a</published>
             <title>~a</title>
             </entry>"
            +author+ +author-uri+ +content+ +id+ +link+
            +published+ +title+))

    (+feed-category-term+ "testing")
    (+feed-category-label+ "/r/testing")
    (+feed-id+ "The Feed")
    (+feed-icon+ "http://example.com/feed.png")
    (+feed-logo+ "http://example.com/logo.png")
    (+feed-link-website+ "http://example.com")
    (+feed-link-self+ "http://example.com/atom.xml")
    (+feed-subtitle+ "The SubTitle")
    (+feed-title+ "The Title")
    (+feed-author-name+ "The Author")
    (+feed-author-uri+ "http://example.com/theauthor")
    (+feed-description+ "The description")
    (+feed1+
      (format nil
              "<feed>
               <title>~a</title>
               <subtitle>~a</subtitle>
               <icon>~a</icon>
               <category term=\"~a\" label=\"~a\"/>
               <link rel=\"alternate\" href=\"~a\" type=\"text/html\" />
               <link rel=\"self\" href=\"~a\" />
               <logo>~a</logo>
               <summary>~a</summary>
               <author><name>~a</name><uri>~a</uri></author>
               <author><name>~a</name><uri>~a</uri></author>
               <id>~a</id>
               </feed>"
              +feed-title+
              +feed-subtitle+
              +feed-icon+
              +feed-category-term+ +feed-category-label+
              +feed-link-website+
              +feed-link-self+
              +feed-logo+
              +feed-description+
              +feed-author-name+ +feed-author-uri+
              +feed-author-name+ +feed-author-uri+
              +feed-id+
              )))

(defun true (x) (not (null x)))

(defun get-node-text (xml-doc selector)
  ($ (inline xml-doc) selector (text) (node)))

(deftest to-feed ()
  (let ((xml (parse +feed1+)))
    (symbol-macrolet ((feed (alimenta::-to-feed xml :atom)))
      (should be equal +feed-title+ (slot-value feed 'alimenta:title))
      (should be equal +feed-link-website+ (slot-value feed 'alimenta:link))
      (should be equal +feed-link-self+ (slot-value feed 'alimenta:feed-link))
      (should be equal +feed-description+ (slot-value feed 'description))
      (should be equal +feed-id+ (slot-value feed 'id))
      (should be equal +feed-subtitle+ (slot-value feed 'subtitle))
      (should be equal +feed-icon+ (slot-value feed 'icon))
      (should be equal +feed-logo+ (slot-value feed 'logo))

      (should be equal +feed-category-term+
              (slot-value
                (elt
                  (slot-value feed 'categories)
                  0)
                'term))
      (should be equal +feed-category-label+
              (slot-value
                (elt
                  (slot-value feed 'categories)
                  0)
                'label))

      (should be equal +feed-author-name+
              (slot-value
                (elt (slot-value feed 'authors) 0)
                'name))
      (should be equal +feed-author-uri+
              (slot-value
                (elt (slot-value feed 'authors) 0)
                'uri))

      ;(should be equal +feed-title+ (slot-value feed 'alimenta:title))
      ;(should be equal +feed-title+ (slot-value feed 'alimenta:title))
      ;(should be equal +feed-title+ (slot-value feed 'alimenta:title))
      )
    )
  )

(deftest make-item ()
  (let ((xml (lquery:$ (inline (plump:parse +entry1+)) "entry" (node))))
    (symbol-macrolet ((item (alimenta::make-item xml :atom)))
      (should be true item)
      (should be equal +link+ (slot-value item 'alimenta:link))
      (should be equal +content+ (slot-value item 'alimenta:content))
      (should be equal +author+ (slot-value item 'alimenta::author))
      (should be equal +author-uri+ (slot-value item 'author-uri))
      (should be equal +id+ (slot-value item 'alimenta:id)))))

(defparameter *tmp* nil)
(deftest generate-xml ()
  (let* ((xml ($ (inline (parse +entry1+)) "entry" (node)))
         (item (alimenta::make-item xml :atom)))
    (symbol-macrolet ((generated-xml (alimenta::generate-xml item :atom)))
      (should be equal +title+
              ($ (inline generated-xml) "entry > title" (text) (node)))
      (should be equal +author+
              ($ (inline generated-xml) "entry > author > name" (text) (node)))
      (should be equal +author-uri+
              ($ (inline generated-xml) "entry > author > uri" (text) (node)))
      (should be equal +id+
              ($ (inline generated-xml) "entry > id" (text) (node)))
      (should be equal +content+
              ($ (inline generated-xml) "entry > content" (text) (node)))
      (should be equal +link+
              ($ (inline generated-xml) "entry > link" (attr "href") (node)))
      ;; TODO: deal with dates . . .
      )))

(defun do-test (&optional (test nil))
  (let ((st:*test-output* *debug-io*))
    (multiple-value-bind (result hm? errors) (st:test :test test)
      (format t
              "~&Returns: ~a~%Error:~%~{~a~^~%~}~%Failures-vals:~%~{~a~^ ~}~%"
              result
              errors
              hm?
              ))))