(defpackage :music
  (:use :common-lisp :cl-who :hunchentoot)
  (:export #:start-music-server #:stop-music-server #:insert-sample-data)
  (:documentation "A simple music database with a web interface."))

(in-package :music)

;;;; * Database and search interface

(defvar *music-database-directory* "/tmp/music/")

(defun open-database ()
  "Open the music database in DB-ROOT"
  (ele:open-store (list :BDB *music-database-directory*)))

(defun close-database ()
  (ele:close-store))

;;;; ** Albums

(defun %albums ()
  (or (ele:get-from-root :albums)
      (ele:add-to-root :albums (ele:make-btree))))

(defclass album ()
  ((id :type integer :reader id :initarg :id)
   (title :type (or string null) :initarg :title :accessor title)
   (artist :type (or string null) :initarg :artist :accessor artist)
   (year :type (integer 0) :initarg :year :accessor year)
   (genre :type genre :initarg :genre :accessor genre))
  (:metaclass ele:persistent-metaclass))

(defmethod initialize-instance :around ((instance album) &rest keys &key genre id)
  (unless id
    ;; compute ID for this album.
    (unless (ele:get-from-root :album-index)
      (ele:add-to-root :album-index 0))
    (setf id (ele:add-to-root :album-index (1+ (ele:get-from-root :album-index)))
          keys (list* :id id keys)))
  (etypecase genre
    (genre (apply #'call-next-method instance keys))
    (string
       (remf keys :genre)
       (apply #'call-next-method instance :genre (or (find-genre genre)
                                                     (find-genre "rock"))
              keys))))

(defun insert-album (&key title artist year genre)
  (let ((album (make-instance 'album :title title :artist artist :year year :genre genre)))
    (setf (ele:get-value (id album) (%albums)) album)
    album))

(defun find-album (&key title artist year genre)
  (let ((results '()))
    (etypecase genre
      ((or null genre) t)
      (string (setf genre (find-genre genre))))
    (ele:map-btree (lambda (id album)
                     (declare (ignore id))
                     (when (and (or (null title) (string= "" title) (string= title (title album)))
                                (or (null artist) (string= "" artist) (string= artist (artist album)))
                                (or (null year) (= year (year album)))
                                (or (null genre)  (eql genre (genre album))))
                       (push album results)))
                   (%albums))
    results))

(defun find-album-by-id (id)
  (ele:get-value id (%albums)))

;;;; ** Genres

(defclass genre ()
  ((description :type string :initarg :description :accessor description))
  (:metaclass ele:persistent-metaclass))

(defun %genres ()
  (or (ele:get-from-root :genres)
      (ele:add-to-root :genres (ele:make-btree))))

(defun find-genre (name)
  (ele:get-value name (%genres)))

(defun insert-genre (name)
  (setf (ele:get-value name (%genres)) (make-instance 'genre :description name)))

;;;; * Web interface

(setq *dispatch-table* (list 'dispatch-easy-handlers 'default-dispatcher))

(defvar *music-server* nil)

(defun start-music-server ()
  (open-database)
  (setf *music-server* (start-server :port 8080 :name 'music-server)
        ;; enable debugging info
        hunchentoot:*show-lisp-errors-p* t
        hunchentoot:*show-lisp-backtraces-p* t))

(defun stop-music-server ()
  (close-database)
  (stop-server *music-server*))

(defun insert-sample-data ()
  (insert-genre "rock")
  (insert-genre "jazz")
  (insert-genre "alternative")
  (insert-album :title "Dark Side of the Moon"
                :artist "Pink Floyd"
                :year 1973
                :genre "rock")
  (insert-album :title "Hotel California"
                :artist "The Eagles"
                :year 1976
                :genre "rock")
  (insert-album :title "A Love Supreme"
                :artist "John Coltrane"
                :year 1964
                :genre "jazz")
  (insert-album :title "Kind of Blue"
                :artist "Miles Davis"
                :year 1959
                :genre "jazz")
  (insert-album :title "Doolittle"
                :artist "Pixies"
                :year 1989
                :genre "alternative"))

(defmacro standard-page ((&key title) &body body)
  `(with-html-output-to-string (*standard-output* nil :indent t)
     (:html :xmlns "http://www.w3.org/1999/xhtml"
            (:head
             (:title ,title)
             (:link :type "text/css" :rel "stylesheet" :href "/style.css")
             (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8"))
            (:body
             (:h1 ,title)
             ,@body))))

(define-easy-handler (music-listing :uri "/list")
    (title artist year genre)
  (when (stringp year)
    (setf year (parse-integer year :junk-allowed t)))
  (when (stringp genre)
    (setf genre (find-genre genre)))
  (let ((albums (sort (find-album :title title :artist artist :year year :genre genre)
                      #'string< :key #'title)))
    (standard-page (:title "Album Listing")
      (htm
       (:table
        (:tr
         (:th "Title")
         (:th "Artist")
         (:th "Year")
         (:th "Genre")
         (:th))
        (dolist (album albums)
          (htm (:tr (:td (fmt (title album)))
                    (:td (fmt (artist album)))
                    (:td (fmt (princ-to-string (year album))))
                    (:td (fmt (description (genre album))))
                    (:td (:a :href (format nil "edit?id=~D" (id album)) "Edit")))))
        (:form :action "list"
              (:tr
               (:td (:input :type "text" :name "title" :size 20))
               (:td (:input :type "text" :name "artist" :size 20))
               (:td (:input :type "text" :name "year" :size 6))
               (:td (:input :type "text" :name "genre" :size 10))
               (:td (:input :type "submit" :value "Search")))))
       ))))

(define-easy-handler (edit-entry :uri "/edit")
    (id title artist year genre)
  (standard-page (:title "Edit Album")
    (let ((album (find-album-by-id (parse-integer id :junk-allowed t))))
      (when title (setf (title album) title))
      (when artist (setf (artist album) artist))
      (when year (setf (year album) (parse-integer year)))
      (when genre (setf (genre album) (find-genre genre)))
      (htm
       (:form :action "edit"
              (:input :type "hidden" :name "id" :value id)
              (:table
               (:tr
                (:td "Title") (:td (:input :type "text" :name "title" :value (title album))))
               (:tr
                (:td "Artist") (:td (:input :type "text" :name "artist" :value (artist album))))
               (:tr
                (:td "Year") (:td (:input :type "text" :name "year" :value (year album))))
               (:tr
                (:td "Genre")
                (:td (:select :name "genre"
                              (ele:map-btree (lambda (name genre)
                                                (htm (:option :selected (if (eql (genre album) genre)
                                                                          t
                                                                          nil)
                                                              :value name (fmt name))))
                                            (%genres)))))
               (:tr
                (:td :colspan 2
                     (:input :type "submit" :value "Save Changes")))))
       (:p (:a :href "list" "Done."))))))

;; Copyright (c) 2008 Edward Marco Baringer
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are
;; met:
;;
;;  - Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;;
;;  - Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;;  - Neither the name of Edward Marco Baringer, Luca Capello, nor
;;    BESE, nor the names of its contributors may be used to endorse
;;    or promote products derived from this software without specific
;;    prior written permission.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.