(in-package :cl-user)

 (ql:quickload :clack-middleware-postmodern)
 

 (ql:quickload '(:fwoar.lisputils :araneus :cl-markup :colors :lquery :plump :postmodern
                 :sxql :clack-middleware-postmodern :dexador :spinneret :ubiquitous :iterate

                 :jonathan :cl-actors :simple-tasks :cl-oid-connect :fwoar.lisputils
                 :serapeum))

 (declaim (optimize (speed 0) (safety 3) (debug 2)))

 (define-modify-macro aconsf (key value)
                      (lambda (place k v)
                        (acons k v place)))
 
 (aconsf drakma:*text-content-types*
         "application" "rdf+xml")
 (aconsf drakma:*text-content-types*
         "application" "rss+xml")
 (aconsf drakma:*text-content-types*
         "text" "rss+xml")

 ;(load "utils.lisp")

 (load "package.lisp")

 (load "rss.lisp")
 
 (in-package plump-dom)

 (defmethod serialize-object :around ((node element))
   (when (string= (tag-name node) "iframe")
     (make-text-node node))
   (call-next-method))

 (in-package :whitespace)

 (use-package :fwoar.lisputils)
 (use-package :araneus)

 (ubiquitous:restore :whitespace)
 
 
 (defparameter *app* (make-instance 'ningle:<app>))
 
 (handler-bind ((warning #'sb-ext::muffle-warning))
   (let* ((feed-urls (ubiquitous:value 'feed 'urls))
          (plump-parser:*tag-dispatchers* plump:*xml-tags*)
          (docs (map 'vector (lambda (x) (plump:parse (drakma:http-request x))) feed-urls)))
     (defparameter *feeds* (map 'vector (lambda (x) (make-rss-feed x)) docs))))

 (defparameter *db-connection-info* (ubiquitous:value 'db))
 

 (defmacro with-whitespace-db (&body body)
   `(postmodern:with-connection *db-connection-info*
      ,@body))

 (defmacro wc (&body body)

   "Utility function for the REPL"

   `(with-whitespace-db ,@body))
 
 (defmacro with-xml-tags (&body body)
   `(let ((plump:*tag-dispatchers* plump:*xml-tags*))
      ,@body))

 (load "base-template.lisp")

 
 (defmacro defun-from-value (name value)
   `(setf (symbol-function ',name) ,value))
 
 (defun-from-value jsonapi-encoder
                   (jonathan.helper:compile-encoder () (success result)
                     (list :|success| success
                           :|result| result)))
 
 ; ; ;  Ultimately, this will only serialize the feed if the client
 (cl-oid-connect:def-route ("/feeds/add" (params) :method :post :app *app*)

   (ningle.context:with-context-variables (session)

     (let ((user-info (gethash :app-user session))

           (result '(302 (:location "/")))

           (api (string= (cl-oid-connect:assoc-cdr "api" params 'string=) "yes"))
           (url (cl-oid-connect:assoc-cdr "url" params 'string=))

           (plump-parser:*tag-dispatchers* plump-parser:*xml-tags*))
       (cl-oid-connect:require-login

         (when (neither-null params user-info)
           (handler-case

             (let* ((doc (plump:parse (drakma:http-request url)))

                    (uid (slot-value user-info 'id)))

               (multiple-value-bind (added-feed dao-feed) (store-feed doc)

                 (subscribe-to-feed uid (slot-value dao-feed 'id))
                 (when api

                   (setf result `(200 (:Content-Type "application/json")
                                  (,(jsonapi-encoder t added-feed)))))))

             (cl-postgres-error:unique-violation
               ()
               (when api
                 (setf result

                       `(400 () (,(jsonapi-encoder nil "Feed already saved")))))))))

       result)))
 

 ;;; TODO: add needs to return the new content, so that angular can append it
 

 (defparameter *userasdfs* nil)
 #|(cl-oid-connect:require-login
     ))|#
 

 ;;; this will be bound by calls to with-palette
 ;;; probably should be refactored out
 (defparameter *palette* nil)
 
 (defparameter *colorscheme* (make-instance 'colors:colorscheme))
 
 (defun get-theme-css ()
   (colors:with-palette (*palette*)
     (flet ((combine-unit-q (quant unit) (format nil "~d~a" quant unit)))
       (let* ((header-height 9)

              (main-right-margin (* 0.618 (- 100 header-height)))

              (height-units "vh")
              (ss (lass:compile-and-write
                    `(* :color ,(colors:colorscheme-fg *colorscheme*))
 

                    `(body
                       :background-color ,(colors:colorscheme-bg *colorscheme*))

 
                    `((:or h1 h2 h3)
                      :color ,(colors:colorscheme-fg-highlight *colorscheme*))
                    `(.feed-header
                       :background-color ,(colors:colorscheme-bg-highlight *colorscheme*))
 
                    `((:or h4 h5 h6) :color ,(colors:colorscheme-fg-highlight *colorscheme*))
 
                    `(header
                       :border-bottom "thin" "solid" ,(colors:colorscheme-accent *colorscheme*)
                       :height ,(combine-unit-q header-height height-units)
                       :font-size ,(combine-unit-q (* 0.75 header-height) height-units)
                       :line-height ,(combine-unit-q header-height height-units)
                       (.flip-button
                         :background-color ,(colors:colorscheme-fg *colorscheme*)
                         :color ,(colors:colorscheme-bg *colorscheme*))
                       ((:and .flip-button :focus)
                        :outline none)
                       ((:and .flip-button :hover)

                        :font-size ,(combine-unit-q (* 0.25 header-height) height-units)))

 
                    `(main

                       :border-left medium solid ,(colors:colorscheme-accent *colorscheme*)

                       :height ,(combine-unit-q (- 100 header-height) height-units)

                       ("#add-form"
                         :box-shadow "0em" "0em" "0.2em" "0.2em" ,(colors:colorscheme-accent *colorscheme*)

                         ((:or input button)

                          :background-color ,(colors:colorscheme-bg *colorscheme*)
                          :color ,(colors:colorscheme-fg *colorscheme*))

                         )
                       )

 
                    `((:or a (:and a :visited) (:and a :active) code.url)
                      :color ,(colors:colorscheme-fg-highlight *colorscheme*))
 
                    `(section#sidebar

                       :transition opacity "0.5s" ease

                       (ul.menu
                         ((li + li)
                          :border-top "thin" "solid" ,(colors:colorscheme-fg-highlight *colorscheme*))
                         ((:and li :hover)
                          :background-color ,(colors:colorscheme-hover-highlight *colorscheme*)
                          :color ,(colors:colorscheme-fg-highlight *colorscheme*))))
 
                    `(.feed
                       :border-bottom thick solid ,(colors:colorscheme-accent *colorscheme*)
                       :border-left none)
 
                    `(.link-header :background-color ,(colors:colorscheme-bg-highlight *colorscheme*))
                    `(.link
                       :border-top thin solid ,(colors:colorscheme-fg *colorscheme*)
                       :border-bottom none
 
 
                       (.link-info
                         :color ,(colors:colorscheme-fg-deemph *colorscheme*)
                         :border-bottom "thin" "solid" ,(colors:colorscheme-fg *colorscheme*)
                         ((:or a span)
                          :color inherit)
                         ((:and a :hover)
                          :color ,(colors:colorscheme-fg *colorscheme*))
                         ))

                    `((:and .feed-header :hover)
                      :background-color ,(colors:colorscheme-hover-highlight *colorscheme*))
 
                    `((.link.closed .link-header)
                      :background-color ,(colors:colorscheme-bg *colorscheme*))
 
                    `((:or (:and .link-header :hover) (.link.closed (:and .link-header :hover)))
                      :background-color ,(colors:colorscheme-hover-highlight *colorscheme*)))))

         (declare (ignorable main-right-margin)) ; TODO: use this!!!

         `(200 (:content-type "text/css") (,ss))))))

 (load "route-atoms.lisp")
 
 (define-view json-feed (the-feeds)
   `(200 (:content-type "application/json" :cache-control "private, max-age=300")
     (,(jsonapi-encoder t the-feeds))))
 
 (define-controller json-feed (params)
   (ningle.context:with-context-variables (session)
     (let* ((user-info (gethash :app-user session))
            (*feeds* (if user-info (deserialize user-info) *feeds*)))
       (setf *userasdfs* user-info)
       *feeds*)) )
 
 (cl-oid-connect:def-route ("/demo" (params) :app *app*)
   (base-template-f t))

 
 (defroutes *app*

   (("/feeds/json") (araneus:as-route 'json-feed))

   (("/theme/:scheme.css") (araneus::compose-route (css) css))
   (("/userinfo.json") (araneus::compose-route (id) userinfo))
   (("/login") (araneus::compose-route (id) login))

   (("/logout") (araneus::compose-route (logout) redirect))

   (("/") (araneus:as-route 'root)))

 
 (defun assoc-cdr-alternatives (alist alt1 alt2 &optional (test #'eql))
   (aif (cl-oid-connect:assoc-cdr alt1 alist test)
     it
     (cl-oid-connect:assoc-cdr alt2 alist test)))
 
 (cl-oid-connect::setup-oid-connect *app* (userinfo &rest args)
   (declare (ignore args) (optimize (speed 0) (safety 3) (debug 3)))
   (flet ((get-received-id (userinfo) (assoc-cdr-alternatives userinfo :id :sub))

          (get-db-user (received-id) (car (postmodern:select-dao 'reader_user (:= :foreign-id received-id))))

          (get-first-name (userinfo) (assoc-cdr-alternatives userinfo :first--name :given--name))
          (get-last-name (userinfo) (assoc-cdr-alternatives userinfo :last--name :family--name))
          (get-link (userinfo) (assoc-cdr-alternatives userinfo :link :profile)))
 
     (postmodern:with-transaction ()
       (let ((received-id (get-received-id userinfo)))
         (aif (get-db-user received-id) it
           (postmodern:make-dao
             'reader_user
             :foreign-id received-id
             :first-name (get-first-name userinfo)
             :last-name (get-last-name userinfo)
             :name (cl-oid-connect:assoc-cdr :name userinfo)
             :email (cl-oid-connect:assoc-cdr :email userinfo)
             :gender (cl-oid-connect:assoc-cdr :gender userinfo)
             :link (get-link userinfo)
             :locale (cl-oid-connect:assoc-cdr :locale userinfo)))))))

 (defun update-feed (url)

   (with-whitespace-db

     (postmodern:with-transaction ()
       (upsert-feed (make-rss-feed (with-xml-tags (plump:parse (drakma:http-request url))))))))
 

 (defmacro amapcar-with-body (list &body forms)
   (alexandria:once-only (list)
     `(mapcar (lambda (it) ,@forms)
              ,list)))
 

 (defun update-all-feeds ()

   (with-whitespace-db

     (let ((urls (postmodern:query (:select 'fetch-url :from 'rss-feed-store))))

       (amapcar-with-body urls
         (restart-case
           (apply #'update-feed it)
           (continue-updates () (warn (format nil "Skipping feed with fetch-url: ~s" it)))
           (use-value (v) (update-feed v)))))))

 
 (defun minutes (minutes) (* minutes 60))
 

 (defun continue-updates (e)
   (declare (ignore e))
   (let ((restart (find-restart 'continue-updates)))
     (when restart
       (format t "continuing")
       (invoke-restart restart))))
 

 (let (update-thread stop)
   (defun start-update-thread ()
     (setf update-thread
           (bordeaux-threads:make-thread
             (lambda ()
               (loop

                 (handler-bind ((drakma:parameter-error #'continue-updates))
                   (update-all-feeds))

                 (sleep (ubiquitous:value 'update-frequency))
                 (when stop
                   (return-from nil nil))))
             :name "Whitespace Update Thread")))
   (defun stop-update-thread ()
     (setf stop t)
     (setf update-thread nil)))
 

 (let ((handler nil))
   (defun stop () (clack:stop (pop handler)))
 
   (defun start (&optional tmp)

     (cl-oid-connect:initialize-oid-connect
       (ubiquitous:value 'facebook 'secrets)
       (ubiquitous:value 'google 'secrets))

     (let ((server (if (> (length tmp) 1)
                     (intern (string-upcase (elt tmp 1)) 'keyword)
                     :hunchentoot)))
       (push (clack:clackup
               (lack.builder:builder
                 :backtrace
                 :session
                 ;:csrf
                 (lambda (app) (lambda (env)
                                 (postmodern:with-connection *db-connection-info*
                                                             (funcall app env))))
                 (:static :path "/static/" :root #p"./static/")
                 *app*) :port 9090 :server server)
             handler)))
 
   (defun restart-clack ()
     (do () ((null handler)) (stop))
     (start)))