#|
  This file is a part of stoe project.
  Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#

(uiop:define-package :stoe/core/resources
    (:use :cl :blackbird
          :stoe/core/utils
          :stoe/core/file
          :stoe/core/modules
          :stoe/core/jobs)
  (:export #:resource #:res-path #:res-loaded-p
           #:shared-resource
           #:binary-resource #:res-buffer
           #:stream-resource #:res-stream
           #:lisp-resource #:res-data
           #:resource-proxy #:res-deref
           #:load-bin-resource #:load-stream-resource
           #:load-lisp-resource #:unload-resource))
(in-package :stoe/core/resources)

(defvar *resources-db* (make-hash-table :test 'equal))

(defclass resource ()
  ((path :initarg :path :reader res-path)
   (loaded :initarg :loaded :initform nil :reader res-loaded-p))
  (:documentation "Base class for a resource."))

(defclass shared-resource (resource shared-object)
  ()
  (:documentation "Base class for a shared resource."))

(defclass binary-resource (shared-resource)
  ((buffer :initarg :buffer :type '(array (unsigned-byte 8) (*)) :reader res-buffer))
  (:documentation "Resource containing binary data."))

(defclass stream-resource (resource)
  ((stream :initarg :stream :accessor res-stream))
  (:documentation "Streaming resource."))

(defclass lisp-resource (resource)
  ((data :initarg :data :reader res-data))
  (:documentation "Resource defined in lisp."))

(defclass resource-proxy ()
  ((resource :initarg :resource))
  (:documentation "Proxy class of a resource."))

(defgeneric res-deref (proxy))
(defmethod res-deref ((proxy resource-proxy))
  (with-slots (resource) proxy
    (tg:weak-pointer-value resource)))

(defun initialize (&optional argv)
  "Initialize resources module."
  (declare (ignore argv)))

(defun finalize ()
  "Finalize resources module."
  (when (> (hash-table-count *resources-db*) 0)
    (format t "There are still ~d resources in the database~%" (hash-table-count *resources-db*))
    (loop for res being the hash-values in *resources-db*
       do (format t "  file ~a is still referenced by ~d proxies~%" (pathname-path (res-path res))
                  (slot-value res 'refcount)))
    (clrhash *resources-db*)))

(defun update (delta-time)
  (declare (ignore delta-time)))

(defmodule stoe/core/resources :resources)

(defun register-resource (res)
  (assert (null (gethash (res-path res) *resources-db*)))
  (setf (gethash (res-path res) *resources-db*) res))

(defun unregister-resource (res)
  (assert (gethash (res-path res) *resources-db*))
  (remhash (res-path res) *resources-db*))

(defun make-resource (path type)
  (let ((res (gethash path *resources-db*))
        (newres nil))
    (unless res
      (setf res (make-instance type :path path))
      (register-resource res)
      (setf newres t))
    (values (make-resource-proxy res) newres)))

(defmethod dec-ref :after ((res shared-resource))
  (with-slots (refcount) res
    (when (= refcount 0)
      (unregister-resource res))))

(defun make-resource-proxy (res)
  (let ((proxy (make-instance 'resource-proxy :resource (tg:make-weak-pointer res))))
    (tg:finalize proxy (lambda () (dec-ref res)))
    (inc-ref res)
    proxy))

(defun load-bin-resource (path)
  (multiple-value-bind (proxy newres) (make-resource path 'binary-resource)
    (values proxy (if newres
                    (alet ((data (load-file path)))
                      (let ((res (res-deref proxy)))
                        (with-slots (buffer loaded) res
                          (setf buffer data)
                          (setf loaded t))
                        res))
                    (promisify (res-deref proxy))))))

(defun load-stream-resource (path)
  (declare (ignore path)))

(defun load-lisp-resource (path)
  (multiple-value-bind (proxy newres) (make-resource path 'lisp-resource)
    (values proxy (if newres
                      (alet ((s (load-file path :type 'character)))
                        (let ((res (res-deref proxy)))
                          (with-slots (data loaded) res
                            (setf data (safe-read-from-string s))
                            (setf loaded t))
                          res))
                      (promisify (res-deref proxy))))))

(defun unload-resource (proxy)
  (tg:cancel-finalization proxy)
  (with-slots (resource) proxy
    (dec-ref (tg:weak-pointer-value resource))))