(in-package :com.tee-it-up-golf.web)

;;; Web Application

(defclass golf-application (standard-application
			    static-roots-application-mixin
			    cookie-session-application-mixin
			    elephant-store-application-mixin)
  
  ())

;;; Utility Components and macros

;; Helper Macros and Functions

(defmacro component-controls (&body controls)
  `(progn
     ,@(mapcar (lambda (control)
		 `(<:li :class "control"
			(<ucw:a :action ,(cadr control)
				(<:as-html ,(car control)))))
	       controls)))

(defmacro defcontainer (name (&rest supers) &body children)
  `(defcomponent ,name ,(or supers '(container))
     ()
     (:default-initargs
	 :contents (list
		    ,@(mapcar (lambda (c) `(cons ',(car c)
					    (make-instance ',(cadr c) ,@(cddr c))))
			     children)))))

(defun cross-component-link (link-text action-object from-component)
  (let ((id (ps:ps-gensym "id")))
    (<:a :href (action-href action-object :component from-component)
	 :id id
	 (<:as-is link-text))
    ))

;; Windows

(defcomponent golf-window (standard-window-component)
  ()
  (:default-initargs
    :title "Tee It Up Golf"
    :dojo-debug-p nil
    :stylesheet '("static/css/tee-it-up.css")))

;; Widgets

(defcomponent golf-widget-component (html-block-element-mixin)
  ()
  (:documentation "Widget component that sets css-class to class-name by default"))


(defmethod initialize-instance :after ((c golf-widget-component)
				       &rest keys)
  (declare (ignore keys))
  (unless (and (slot-boundp c 'ucw::css-class) (html-element.css-class c))
    (setf (html-element.css-class c)
	  (string-downcase (symbol-name (class-name (class-of c)))))))

;; Containers

(defcomponent composite-component (container golf-widget-component)
  ()
  (:documentation "Simple container that renders each child in a div"))

(defmethod render ((component composite-component))
  (mapc (lambda (c) (render (cdr c)))
	(container.contents component)))

;; Show Viewer

(defcomponent show-viewer (golf-widget-component item-viewer)
  ())

(defgeneric render-controls (component))

(defmethod render :after ((self show-viewer))
  (render-controls self))

(defmethod render-item :around ((self show-viewer) show)
  (<:span :class "golf-show-body"
	  (call-next-method)))

(defmethod render-controls :around ((self show-viewer))
  (<:ul :class "golf-controls"
	(call-next-method)))

(defmethod render-item ((viewer show-viewer) (show null))
  (declare (ignore viewer show))
  (<:as-html "No Show"))

(defcomponent standard-show-viewer (show-viewer)
  ())

(defmethod render-item ((self standard-show-viewer) (show radio-show))
  (<:h1 (<:as-html (show-title show)))
  (<:h2 (<:format "Date: ~A" (date-string (show-date show))))
  (<:p (<:as-html (transcript show))))

(defmethod render-controls ((self standard-show-viewer)))

(defcomponent full-show-viewer (standard-show-viewer)
  ())

(defmethod render-controls :before ((self full-show-viewer))
  (component-controls ("Ok" (answer t))))

(defcomponent compact-show-viewer (show-viewer)
  ())

(defmethod render-item ((self compact-show-viewer) (show radio-show))
  (<:format "~A: ~A"
	    (brief-date (show-date show))
	    (show-title show)))

;; Show Selector

(defcomponent show-selector (show-viewer item-selector)
  ())

(defmethod render-controls ((self show-selector))
  (with-slots (full-viewer-class)
      self
    (let ((show (viewer-item self)))
      (component-controls
	("View" (call full-viewer-class :item show))))))

(defcomponent compact-show-selector (show-selector compact-show-viewer)
  ())

;; Show Lister

(defcomponent show-list (show-viewer query-view elephant-query-view-mixin)
  ()
  (:default-initargs
      :index-class 'golf-db:radio-show :index-slot 'golf-db:show-date))


(defgeneric shows (show-list))

(defmethod shows ((list show-list))
  (current-items list))

(defmethod render :around ((self show-list))
  (<:ul :class "golf-show-list"
	(call-next-method)))

(defmethod render ((self show-list))
  (mapc (lambda (show)
	  (setf (viewer-item self) show)
	  (<:li :class "golf-show-list-item"
		(call-next-method)))
	(shows self)))

;; Show Chooser

(defcomponent show-chooser (show-list compact-show-selector)
  ())

;; Ranged Show Viewer/Chooser

(defcomponent ranged-show-list (cached-query-paged-view-mixin
				query-ranged-view-mixin
				show-list)
  ())

(defcomponent standard-ranged-show-list (ranged-show-list)
  ())

(defcomponent ranged-show-chooser (ranged-show-list show-chooser)
  ())

(defcomponent standard-ranged-show-chooser (ranged-show-chooser
					    standard-ranged-show-list)
  ())

(defmethod shows ((range ranged-show-list))
  (current-items range))

;; respecialize on standard-ranged-show-list
(defmethod render :after ((self standard-ranged-show-list))
  ;; mark with css classes
  (<:p :class "ranged-show-list-pager"
       (<:format "Page ~D of ~D"
		 (1+ (page-offset self))
		 (1+ (page-count self)))
       (<:as-html " ")
       (if (have-previous-page-p self)
	   (<ucw:a :action (scroll-backward self)
		   (<:as-html "Previous"))
	   (<:as-html "Previous"))
       (<:as-html " ")
       (if (have-next-page-p self)
	   (<ucw:a :action (scroll-forward self)
		   (<:as-html "Next"))
	   (<:as-html "Next"))
       (<:as-html " ")
       (<ucw:a :action (scroll-start self)
	       (<:as-html "First"))
       (<:as-html " ")      
       (<ucw:a :action (scroll-end self)
	       (<:as-html "Last"))))

;; Audio Streaming

(defcomponent audio-file-window (window-component)
  ((audio-file :initarg :audio-file :accessor audio-file)))

(defmethod window-component.content-type ((window audio-file-window))
  (audio-file-type (audio-file window)))

(defaction play-file ((c t) (show radio-show))
  (play-file c (audio-data show)))

(defaction play-file ((c t) (file audio-file))
  (call 'audio-file-window :audio-file file)
  (answer t))

(defmethod render :before ((audio-window audio-file-window))
  (setf (get-header (context.response *context*) "Content-Length")
        (format nil "~D" (audio-file-length (audio-file audio-window)))))

(defmethod render ((audio-window audio-file-window))
  ;; this is not so perfectly nice, but the only real error that could
  ;; be triggered is a socket error, and there are now portable ucw
  ;; backend errors for that. Therefore I choose to ignore-errors in
  ;; case some non-connection-related error occurs (i.e. the
  ;; 'abort-backend-request restart will not work) rather than rely on
  ;; the iolib backend net.sockets:socket-error type
  (ignore-errors 
    (handler-case 
	(handle-raw-request
	    (:content-type (window-component.content-type audio-window))
	  (write-audio-file (audio-file audio-window)
			    (ucw::network-stream (context.response *context*))))
      (t ()
	(invoke-restart 'ucw::abort-backend-request)))))