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

;;; Interview Database

;; Database

(defun delete-database-objects (&rest objects)
  (drop-instances objects))

(defun delete-database-object (object)
  (delete-database-objects object))

;;; Audio Files

;; TODO: check audio-file-type against list of known audio file types
(defpclass audio-file ()
  ((type :initarg :type :accessor audio-file-type)
   (data :initarg :data :accessor raw-audio-data)
   (path-name)))

(defmethod initialize-instance :after ((audio-file audio-file)
				       &key type &allow-other-keys)
  (when (slot-boundp audio-file 'data)
    (setf (audio-data audio-file) (slot-value audio-file 'data)))
  (when type
    (setf (audio-file-type audio-file) type)))

(defmethod drop-pobject :before ((audio-file audio-file))
  (if (slot-boundp audio-file 'path-name)
      (delete-file
       (translate-logical-pathname (slot-value audio-file 'path-name)))))

;; Audio File Protocol
(defgeneric audio-data (audio-file)
  (:documentation "Return the unsigned-byte array representing
   the data of the audio-file"))

(defgeneric (setf audio-data) (new-value audio-file)
  (:documentation "Set the audio-data of the audio-file. The
  new-value may be a stream, byte array, or file name."))

(defgeneric audio-stream (audio-file)
  (:documentation "Returns an unsigned-byte stream attached to
  the audio-data of the audio-file"))

(defgeneric audio-file-length (audio-file)
  (:documentation "Return the length in bytes of the audio-file"))

(defgeneric write-audio-file (audio-file stream)
  (:documentation "Write audio-file data to stream"))

;; Protocol Implementation

;; ;;; Elephant has issues with storing large byte streams so for now the
;; ;;; original trivial implementation is not working, and the data must be
;; ;;; stored in a file
;; (defmethod audio-data ((file audio-file))
;;   (raw-audio-data file))

;; (defmethod (setf audio-data) ((new-value stream) (file audio-file))
;;   (setf (audio-data file) (stream->bytes new-value)))

;; (defmethod (setf audio-data) ((new-value simple-vector) (file audio-file))
;;   (setf (raw-audio-data file) new-value))

;; (defmethod (setf audio-data) ((new-value pathname) (file audio-file))
;;   (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))

;; (defmethod (setf audio-data) ((new-value string) (file audio-file))
;;   (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))

;; (defmethod audio-stream ((file audio-file))
;;   (make-in-memory-input-stream (raw-audio-data file)))

;; (defmethod audio-file-length ((file audio-file))
;;   (length (raw-audio-data file)))


;; Temporary utils

(let ((audio-random-state (make-random-state t)))
  (defun generate-audio-path-name ()
    "Generate a unique path name for audio files"
    (let ((path-name (make-pathname :host "golf"
			 :directory "audio"
			 :name (metabang.utilities:unique-file-name-from-date
				(let ((*random-state* audio-random-state))
				  (arnesi:random-string 4))
				:type nil))))
      (if (file-exists-p (translate-logical-pathname path-name))
	  (generate-audio-path-name)
	  path-name))))



(defun audio-path-name (audio-file)
  "Return pathname of audio file. Generates a new pathname if it does
  not exist yet. The second return value is t if the pathname existed
  before, and nil otherwise"
  (if (slot-boundp audio-file 'path-name)
      (values (slot-value audio-file 'path-name) t)
      (values (setf (slot-value audio-file 'path-name)
		    (generate-audio-path-name))
	      nil)))

(defun open-audio-file-stream (audio-file &rest keys)
  (apply #'open
	 (translate-logical-pathname (audio-path-name audio-file))
	 :element-type 'unsigned-byte
	 keys))

;; Protocol Implementation (for current store data in a file scheme)

(defmethod raw-audio-data ((file audio-file))
  (stream->bytes (open-audio-file-stream file)))

(defmethod audio-data ((file audio-file))
  (stream->bytes (open-audio-file-stream file)))

(defmethod (setf audio-data) ((new-value file-stream) (file audio-file))
  (metabang.utilities:copy-file
   (pathname new-value)
   ;; Have to translate the pathname
   ;; first because SBCL's
   ;; ensure-directories-exist barfs on
   ;; all logical pathnames for some
   ;; reason
   (translate-logical-pathname (audio-path-name file))
   :if-exists :supersede)
  (multiple-value-bind (type subtype) (cl-mime:lookup-mime (pathname new-value))
    (setf (audio-file-type file) (format nil "~A/~A" type subtype))))

(defmethod (setf audio-data) ((new-value simple-vector) (file audio-file))
  (fad:copy-stream (make-in-memory-input-stream new-value)
		   (open-audio-file-stream file :direction :output
					        :if-exists :overwrite
						:if-does-not-exist :create)))

(defmethod (setf audio-data) ((new-value pathname) (file audio-file))
  (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))

(defmethod (setf audio-data) ((new-value string) (file audio-file))
  (setf (audio-data file) (open new-value :element-type 'unsigned-byte)))

(defmethod audio-stream ((file audio-file))
  (open-audio-file-stream file))

(defmethod audio-file-length ((file audio-file))
  (file-length (open-audio-file-stream file)))

(defmethod write-audio-file ((file audio-file) (stream stream))
  (fad:copy-stream (audio-stream file) stream))

;;; Shows

(defpclass radio-show ()
  ((show-title :initarg :title :accessor show-title
	       :index t)
   (show-date :initarg :date :accessor show-date
	      :index t       :initform nil #|(get-universal-time)|#)
   (audio :initarg :audio :accessor audio-data
	  :initform nil   :type (or nil audio-file))
   (transcript :initarg :transcript :accessor transcript :initform "")))

(defmethod initialize-instance :after ((i radio-show) &key &allow-other-keys)
  (let ((show-date (show-date i)))
    (if show-date (setf (show-date i) show-date))))

(defmethod drop-pobject :before ((show radio-show))
  (when-bind audio-file (audio-data show)
    (drop-pobject audio-file)))


(defmethod (setf show-date) :around (new-date (show radio-show))
  (call-next-method (strip-time new-date) show))

;; Query Protocol

(defun get-shows-by (slot-name start end &rest keys)
  (apply #'get-instances-limit 'radio-show slot-name start end keys))

(defun count-shows-by (slot-name start end &rest keys)
  (apply #'count-instances-by
	 'radio-show 'show-date start end keys))